Друзья, помогите с экспортом в эксель или направьте в правильное русло.
Есть таблицы, которые созданы по подобию страниц в файле шаблона. Оригинальный файл содержит более 50 листов. Тут приаттачил легкое подобие. Задача заполнить экселевский файл на основе данных из этих таблиц. Они заполняются по определенному алгоритму...
Идея такая, что через функцию передается имя листа, который нужно заполнить. Это имя в 100% случаев буде совпадать с именем таблицы в БД,
а вот поля некоторые могут иметь отличия . Это скорее исключения, связанное с тем, что некоторые символы в именах полей запрещены. И вроде все красиво можно вставлять через рекордсет xlSheet.Range("A3").CopyFromRecordset rst, но может измениться версия шаблона, например на какой-то странице появится новая колонка. И тогда данные могут съехать. Не соображу, как лучше организовать проверку имен полей из SQL-запроса с именами колонок в файле шаблона.
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.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
Private Sub ExportTetsShablon_Click()
Filling "strA" ' передаем имя страницы, оно будет совпадать с таблицей в Access
End Sub
Function Filling(SheetName$)
Dim strSQL$, m%
Dim rst: Set rst = CreateObject("ADODB.Recordset")
Dim SQLFieldsCount% 'Количество полей в запросе
Dim SblFieldsCount% 'Количество колонок в шаблоне на SheetName$
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim sFileName$ ' имя с которым сохраним итоговый файл
Dim CountMySheet% ' Количество страниц в файле шаблона
'Dim mysheet
Set xlApp = CreateObject("excel.Application")
Set xlBook = xlApp.Workbooks.Open("c:\Temp\Shablon_test.xlsx") ' шаблон в оригинале сложный многостраничный с кодом VBA
For CountMySheet = 1 To xlBook.Worksheets.Count ' найдем нужный лист в книге, т.к. их много
Set xlSheet = xlBook.Sheets(CountMySheet)
'Debug.Print xlSheet.Name
If xlSheet.Name = SheetName Then ' сравниваем имя текущего листа с переданным SheetName$
strSQL = "SELECT * from " & SheetName ' если совпадает имя текущего листа с переданным SheetName$, то делаем запрос к таблице с таким же именем
'Debug.Print strSQL
Set rst = CurrentDb.OpenRecordset(strSQL)
'xlSheet.Range("A3").CopyFromRecordset rst ' идеальный вариант, если SQL запрос будет 100% совпадать с шаблоном
Debug.Print "Количество строк в запросе =" & rst.RecordCount
SQLFieldsCount = rst.Fields.Count
SblFieldsCount = xlBook.Sheets(SheetName).UsedRange.Columns.Count
Debug.Print "Количество полей в запросе =" & SQLFieldsCount
Debug.Print "Количество колонок в шаблоне на " & SheetName & " =" & SblFieldsCount
' в идеале количество полей должно совпадать
If SQLFieldsCount >= SblFieldsCount Then ' в теории полей в исходной таблице может быть больше, если она используется для разных шаблонов
'------------------------------------------------
' далее необходимо вставить данные из запроса в те столбцы, наименования которых совпадают с шаблонными.
' имена столбцов находятся на каждой странице шаблона во второй строке
End If
rst.Close
End If
Next CountMySheet
If Dir("c:\temp") <> "" Then MkDir ("c:\temp") ' если отсутсвует папка, то создадим
sFileName = "c:\temp\test_EXP_" & Date & "_" & "time_" & Format(Time, "hh-mm") & ".xlsx"
xlSheet.SaveAs sFileName ' сохраняем файл
xlBook.Close
Set rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
MsgBox "Готово!"
End Function
