Обмен данными

' Средствами DAO, см. процедуру cmd1_Click(), выполня-
' ется работа с таблицей nin2 базы данных nin1.mdb и 
' имена полей таблицы, (см. цикл For Next), заносятся в
' поле списка lst. Далее пользователь должен выбрать
' поля таблицы для переноса в приложение Excel
Private Sub cmd1_Click()
Dim ws As Workspace, db As Database 
Dim tdef As TableDef, i As Integer
lst.Clear
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("A:\nin1.mdb")
Set tdef = db.TableDefs("nin2")
For i = 0 To tdef.Fields.Count - 1
lst.AddItem tdef.Fields(i).Name
Next i
db.Close: ws.Close
End Sub
' программируется передача таблицы из Access в Excel.
' Cначала объявляются новые объекты Excel, затем - DAO
Private Sub cmd2_Click()
' объект Excel.Application содержит коллекцию Workbooks
Dim xla As New Excel.Application 
' объект Workbook содержит коллекцию Worksheet
Dim xlb As New Excel.Workbook 
' объект Worksheet содержит ячейки
Dim xls As New Excel.Worksheet 
' объект Range - непрерывный набор ячеек
Dim xlr As Excel.Range
Dim ws As Workspace, db As Database, rs As Recordset 
Dim i As Integer, j As Integer, k As Integer, rc As Integer
Dim r As Integer, c As Integer
' описание массива полей таблицы базы данных, выделенных 
' пользователем в поле lst после старта проекта и 
' щелчка на кнопке Access
Dim masFields() As String
' определить выделенные пользователем в поле списка 
' lst поля (таблицы базы данных) для переноса в Excel и
' определить размерность массива masFields() 
' для их (выделенных полей) хранения (ReDim - 
' изменить размерность массива)
For i = 0 To lst.ListCount - 1
If lst.Selected(i) = True Then j = j + 1
Next i
ReDim masFields(j - 1)
' занести данные в массив masFields(j) из поля
' списка (свойство ListCount содержит число 
' элементов списка)
j = 0
For i = 0 To lst.ListCount - 1
If lst.Selected(i) = True Then masFields(j) = lst.List(i): j = j + 1
Next i
' создать рабочее пространство, открыть базу данных
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("A:\nin1")
' создать объекты Excel (экземпляр книги и листа) и 
' активизировать лист Excel
Set xlb = xla.Workbooks.Add
Set xls = xlb.Worksheets.Add
xls.Activate
' в цикле For : Next перебрать выбранные пользователем и 
' занесeнные ранее в массив поля. Для каждого поля 
' формируется SQL-запрос. Далее просматривается 
' весь набор записей для определения количества 
' соответствующих записей
For i = 0 To UBound(masFields)
Set rs = db.OpenRecordset("SELECT nin2." & masFields(i) & " _
FROM nin2")
rs.MoveLast: rs.MoveFirst
' выбрать номера столбцов таблицы Excel, где будут 
' размещены выбранные данные. В первую строку поместить 
' названия полей. Ячейки первой строки делаются 
' объектом xlr и выделяются
c = i + 1 
xls.Cells(1, c) = masFields(i)
Set xlr = xls.Cells(1, c)
xlr.Select
xlr.Font.Bold = True
' ограничить набор данных некоторым числом (например, 10) 
If rs.RecordCount > 10 Then rc = 10 Else rc = rs.RecordCount
' в тот же столбец таблицы (аргумент с) перенести 
' все записи. Далее (цикл For i : Next i) - возврат к 
' началу цикла для перебора всех полей
For r = 2 To rc + 1
xls.Cells(r, c) = rs(masFields(i))
rs.MoveNext
Next r
Next i
' сообщение пользователю о передаче данных в Excel; 
' вопрос о необходимости сохранения их в файле, ввод в 
' диалоговом режиме имени файла; сообщение о 
' сохранении/несохранении файла; закрыть объект - 
' приложение Excel. Синтаксис функции MsgBox дан
' после кода
If MsgBox("I have transported the Access data " & "to an Excel." &_
vbCrLf & vbCrLf & "Do you want to save ?", vbQuestion & _
vbYesNo) = vbYes Then
cdlg.FileName = ""
cdlg.ShowSave
xls.SaveAs (cdlg.FileName)
MsgBox "Data has been saved to file:" & vbCrLf & vbCrLf &_
cdlg.FileName, vbInformation, "Data has been saved"
Else
MsgBox "Data has not been saved!", vbCritical, "Data has not been saved!"
End If
xlb.Saved = True
xla.Quit
End Sub

kkKK = MsgBox("Do you work ?", vbYesNoCancel + vbExclamation, "MsgBox()-Study")
If kkKK = vbYes Then
Form1.Print "He works !!"
ElseIf kkKK = vbNo Then
Form1.Print "He does not work !!"
Else: Form1.Print "He won't work !!"
End If