Выгрузка перекрестного запроса в xcell шаблон |
DoCmd.OpenWQuerry "name", acViewNormal, acReadOnly ' этот запрос создает новую табличку DoCmd.OpenWQuerry "name1", acViewNormal, acReadOnly ' этот запрос создает перекресный запрос DoCmd.Close acQuerry, "name1" ' это закрывает 2й запрос, почему то 1й формирует таблицу но не открывается а второй открывается (странность) DoCmd.TransferSpreadSheet acExport, acSpreadSheetTypeExel5, "name1", "c:\test\test.xlsx"
Private Sub testexcel_Click() 'Объявляем переменные Dim XL As Object Dim XLT As Object Dim newrow As Object Dim rsd As ADODB.Recordset Dim strSQL As String Set rsd = New ADODB.Recordset 'Запрос к базе данных strSQL = "select * from dbo.table where kod = " & Me.kod & "" rsd.open strSQL, CurrentProject.Connection 'Создаем необходимые объекты Set XL = CreateObject("Excel.Application") 'для примера показываю, как можно сразу загружать шаблон без выбора Set XLT = XL.Workbooks.open("C:\testfile.xls") '1 способ если источнике данных всего одна строка With XLT.Worksheets("Лист1") .[a1] = rsd.Fields("field1") .[b1] = rsd.Fields("field2") .[c1] = rsd.Fields("field3") .[d1] = rsd.Fields("field4") End With '2 способ если строк в источнике несколько 'причем мы учтем то, что у нас есть шапка и примечание в Excel 'и мы не знаем, сколько строк у нас вставится 'и поэтому строки будем добавлять в случае необходимости 'зададим, с какой строки будем начинать вставлять данные Rowss = 10 'для нумерации numrow = 1 'запускаем цикл до тех пор, пока не закончатся строки в нашем источнике While Not (rsd.EOF) 'смотрим, если строк больше чем мы задали в шаблоне If Rowss >= 12 Then 'то добавляем строку XLT.Worksheets("Лист1").Rows(Rowss).Insert 'Запомним нашу строку Set newrow = XLT.Worksheets("Лист1").Rows(Rowss) 'и вставим туда копию предыдущей строки 'для того если вдруг у вас там есть объединенные ячейки или какие-то нужные данные 'так как новая строка создастся без всяких объединений и значений XLT.Worksheets("Лист1").Rows(Rowss - 1).Copy newrow 'это просто для примера как можно очистить некий диапазон внутри документа 'XLT.Worksheets("Лист1").Range("A10:F10").ClearContents 'динамически формируем адрес нужной ячейки cell = "a" & Rowss 'и задаем ей значение XLT.Worksheets("Лист1").Range(cell) = numrow cell = "b" & Rowss XLT.Worksheets("Лист1").Range(cell) = rsd.Fields("field5").Value 'переходим на следующую строку Rowss = Rowss + 1 'переходим на следующую строку в источнике данных rsd.MoveNext Else 'а это выполняется до тех пор, пока не закончатся заданные строки в шаблоне 'т.е. если строк в источнике всего 1 то в код, который выше мы даже не попадем cell = "a" & Rowss XLT.Worksheets("Лист1").Range(cell) = numrow cell = "b" & Rowss XLT.Worksheets("Лист1").Range(cell) = rsd.Fields("field5").Value Rowss = Rowss + 1 rsd.MoveNext End If 'для нумерации numrow = numrow + 1 'конец цикла Wend 'это просто пример как можно удалить строку целиком 'XLT.Worksheets("Лист1").Rows(20).Delete 'делаем Excel видимым XL.Visible = True 'Очищаем переменные Set XL = Nothing Set XLT = Nothing Set newrow = Nothing End Sub
http://www.sql.ru/forum/1167592/vygruzka-perekrestnogo-zaprosa-v-xcell-shablon
Комментировать | « Пред. запись — К дневнику — След. запись » | Страницы: [1] [Новые] |