|
|||||||
Экспорт в 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("имя поля запроса")
|
|||||||
Так же в этом разделе:
|
|||||||
|
|||||||
|