MyTetra Share
Делитесь знаниями!
Экспорт в Excel данных из связанных таблиц:
16.03.2019
23:43
Раздел: !Закладки - VBA - Access - DAO

Экспорт в Excel данных из связанных таблиц:


Visual BasicВыделить код

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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

Примечания:
шаблон создаем с одним листом, название ему даем "1". Сам код вешаем на кнопку, которой планируем запускать экспорт. Такую же схему можно реализовать в случае, если первым рекордсетом будет сохраненный запрос SQL, но в этом случае во втором рекордсете нужно будет обращаться к его полю чуть иначе: rsd.Fields("имя поля запроса")

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования