Dim xlApp As Object, xlBook As Object, xlSheet As Object
Dim db As DAO.Database, rsd As DAO.Recordset, rse As DAO.Recordset
Dim sq$, cs&, TmplFileName$
Set db = CurrentDb
sq = "SELECT ... FROM... WHERE... ORDER BY ..." ' выборка данных для первого рекордсета
Set rsd = db.OpenRecordset(sq, dbOpenSnapshot)
If rsd.EOF Then Exit Sub ' проверяем на отсутствие записей
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
TmplFileName = CurrentProject.path & "\Dot\test1.xlt" ' здесь указываем путь к шаблону (задал относительно - так удобно при использовании базы на разных компах
Set xlBook = xlApp.Workbooks.Add(TmplFileName)
Set xlSheet = xlBook.Sheets(1)
cs = 0
Do Until rsd.EOF
If cs > 0 Then Set xlSheet = xlBook.Sheets.Add(, xlBook.Worksheets(cs), , TmplFileName)
cs = cs + 1
xlSheet.Name = ' создаем название листа в формате, например, rsd!Name
xlSheet.Cells(2, 1).Value = ' аналогично ваяем шапку на листе, если есть необходимость - у меня обычно есть
sq = "SELECT...FROM ...WHERE ... cat_id = " & rsd!id & "" ' создаем второй рекордсет и склеиваем по нужному полю
Set rse = db.OpenRecordset(sq, dbOpenSnapshot)
xlSheet.Cells(8, 2).CopyFromRecordset rse ' заполняем листы
rsd.MoveNext
Loop
Set xlSheet = Nothing: Set xlBook = Nothing: Set xlApp = Nothing
Set rse = Nothing: Set rsd = Nothing: Set db = Nothing |