07. Этот пример показывает, как в Access можно заполнить файл Excel разными способами:
1) Заполнение каждой ячейки своим значением
2) Заполнение ячеек из массива
3) Заполнение несколько ячеек 1 значением
4) Заполнение ячеек из ADODB.Recordset
'***************************************************************
' Подписка: "Access - программирование и готовые решения"
' Тема: "Клиенты автоматизации Access"
' Версия: 1 от 16.07.2009
' Автор: Copyright © Leader Access, Ltd
' Сайт: http://www.leadersoft.ru
'***************************************************************
' 07. Пример. Вывод информации в Excel
' Записывается информация о книгах по строкам,
' используя разные варианты: Название, Цена, Автор, Пункт
'***************************************************************
Private Sub butOK_Click()
On Error GoTo 999
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlFileName As String
' Определяем и проверяем имя файла
xlFileName = Application.CurrentProject.Path "\Книги.xls"
If Dir(xlFileName, vbNormal) = "" Then
MsgBox "Файл не найден: " xlFileName, vbCritical, "http://www.leadersoft.ru"
Exit Sub
End If
' Устанавливаем ссылку на страницу
Set xlApp = CreateObject("Excel.Application") ' Открываем Excel
Set xlBook = xlApp.Workbooks.Open(FileName:=xlFileName) ' Открываем файл
Set xlSheet = xlBook.Sheets("Мои книги") ' Выбираем лист книги
xlApp.Visible = True ' Отображаем Excel
' Записываем данные в ячейки, пропустив строку заголовка
' 1 вариант. Сохраняем 1 значение ( 2 строка данных )
xlSheet.Range("A2").Value = "Война и мир"
xlSheet.Range("B2").Value = "200"
xlSheet.Range("C2").Value = "Толстой"
' 2 вариант. Используем массив ( 3 строка данных )
xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(3, 3)).Value = _
Array("Горе от ума", "150", "Грибоедов")
' 3 вариант. Используем одно значение ( Нумерация строк на листе )
xlSheet.Range(xlSheet.Cells(2, 4), xlSheet.Cells(6, 4)).FormulaR1C1 = "=ROW()-1"
' 4 вариант. Используем запрос из базы данных ( 5 и 6 строка данных )
Dim cn As ADODB.Connection, rs As New ADODB.Recordset, SQL As String
Set cn = Application.CurrentProject.Connection
SQL = "SELECT Книга,Сумма,Автор FROM [Пример 04] WHERE Len([Автор]) 0"
rs.Open SQL, cn
xlSheet.Range("A5").CopyFromRecordset rs
rs.Close
Set rs = Nothing
' --- Закрываем Excel и уничтожаем объекты, если это необходимо сделать автоматически ---
' xlBook.Close SaveChanges:=True
' xlApp.Quit
' Set xlSheet = Nothing
' Set xlBook = Nothing
' Set xlApp = Nothing
Exit Sub
999:
MsgBox Err.Description, vbCritical, "http://www.leadersoft.ru"
Err.Clear
End Sub