MyTetra Share
Делитесь знаниями!
Экспорт в Excel данных из связанных таблиц:
Время создания: 16.03.2019 23:43
Раздел: Разные закладки - VBA - Access - DAO
Запись: xintrea/mytetra_db_adgaver_new/master/base/15376497982no7y0edjp/text.html на raw.githubusercontent.com

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

 

 

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.65
Яндекс индекс цитирования