Форум программистов [Powered by Invision Power Board]

Код


List = ActiveSheet.Name
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Sheets("справочник").Visible = True
Sheets("справочник").Activate
ActiveSheet.Range("MacroStart").Select '-например это первый контрагент по списку
Selection.QueryTable.Refresh BackgroundQuery:=False '-обновляемся
Sheets(List).Select
Application.Sheets("справочник").Visible = xlVeryHidden
Application.ScreenUpdating = True
Application.EnableEvents = True

Код


Dim dbAccess As Database
        Dim reRecordSet As Recordset
        Dim stSQL As String
    On Error GoTo ErrorsDB
    Set dbAccess = OpenDatabase("\\server\обмен\Финансовый отдел\БазыДанных\ContractorsBase.mdb") 
    stSQL = "SELECT distinct Contractors.ContraName FROM Contractors order by Contractors.ContraName "
    Set reRecordSet = dbAccess.OpenRecordset(stSQL) ' - коннектимся
    If (reRecordSet.RecordCount > 0) Then
       reRecordSet.MoveFirst
       Do While Not reRecordSet.EOF
       Name = reRecordSet!ContraName   ' - обязательно имя используемого поля базы данных "ContraName"
     Sheets(1).ComboBox1.AddItem Name
        reRecordSet.MoveNext
       Loop
    Else
        MsgBox "Not Found"
    End If
     reRecordSet.Close
        dbAccess.Close
        GoTo Ends
ErrorsDB:
    MsgBox "Произошла ошибка"
Ends:
End Sub

Код


Sub DAO()
Dim dbs As Database
Dim recset As Recordset
Dim rSql As String
Set dbs = OpenDatabase("\\server\обмен\Финансовый отдел\Ананьев Г.А\Базы_Данных_Access\BUDJETS_DATA_1.0.mdb")
rSql = "SELECT OPERLIST.Autor, OPERLIST.DateRecord, OPERLIST.Source, OPERLIST.Sum_Budjet "
rSql = rSql & " FROM OPERLIST WHERE (((OPERLIST.Org_Name) Like '*лимп*'));" ' - перенос строки SQL на новую
Set recset = dbs.OpenRecordset(rSql)
recset.MoveLast '-передвигаемся к последней записи, чтобы показать общее число записей т.к. RecordCount отражает только текущую запись
Debug.Print recset.RecordCount & " - число записей " ' - показываем в Immediate число записей
Debug.Print recset.Fields.Count & " - число столбцов " ' - показываем в Immediate число столбцов
recset.MoveFirst
For Col = 0 To recset.Fields.Count - 1
        ActiveCell.Offset(0, Col).Value = recset.Fields(Col).Name ' - пробиваем в Excel заголовки таблицы
    Next Col
ActiveCell.Offset(1, 0).Select
Do While Not recset.EOF
    For Col = 0 To recset.Fields.Count - 1
        ActiveCell.Offset(0, Col).Value = recset.Fields(Col).Value ' - заполняем таблицу
    Next Col
    recset.MoveNext
    ActiveCell.Offset(1, 0).Activate
Loop
recset.Close
dbs.Close
End Sub