Данные с Access в Excel

[sahtheey]

Привет, всем!
Подскажите, как отобразить данные с таблицы (можно с запроса) в готовом шаблоне xls формата. Перепробовала все варианты которые выложены в этом форуме, но не получается.

Пробовала в таком типе:

Public Sub btnSvod(strPathofTmpl As String, strNameofTblQry As String, iRow As Integer, iCol As Integer, iNSH As Integer, vrNofSh As Variant)

'strPathofTmpl - имя вместе с путем файла шаблона
'strNameofTblQry - имя сохраненного запроса
'iRow - начальная строка экспорта в файле шаблона
'iCol - начальныйстолбец экспорта в файле шаблона
'iNSH - номер листа книги в файле шаблона
'vrNofSh - новое имя листа книги шаблона, если null - имя остается старым

Dim db As DAO.Database
Dim rst As DAO.Recordset


Pathname = CurrentProject.Path
FNShablon = Pathname + "\FORM3_SHABLON.xls"

Dim xlAPP As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim rng As Range

Dim vArr() As Variant

Set db = CurrentDb()
DoCmd.RunMakro "Svod"
rst.MoveLast: rst.MoveFirst
vArr = rst.GetRows(rst.RecordCount)

Dim i As Integer, j As Integer
For i = 0 To UBound(vArr, 1)
For j = 0 To UBound(vArr, 2)
vArr(i, j) = Nz(vArr(i, j), Empty)
Next j
Next i


Set xlAPP = New Excel.Application
xlAPP.Visible = True
Set xlBook = xlAPP.Workbooks.Open("FNShablon.xls ")
Set xlSheet = xlBook.Worksheets("Лист 1")
If Not IsNull(vrNofSh) Then xlSheet.Name = CStr(vrNofSh) 'str$(Date)
Set rng = xlSheet.Cells(7, TZ)
Set rng = rng.Resize(UBound(vArr, 2) + 1, UBound(vArr, 1) + 1)
rng.Formula = xlAPP.WorksheetFunction.Transpose(v Arr)

rst.Close
Set rst = Nothing
Set db = Nothing
Set rng = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlAPP = Nothing

End Sub

[Teslenko_EA]

Здравствуйте sahtheey.
позволил себе слегка подкорректировать Ваш код

Sub toExcel()
    'btnSvod "C:\Книга1.xls", "Table", 1, "A3", "НовоеИмяЛиста"
    btnSvod CurrentProject.Path + "\FORM3_SHABLON.xls", "select * from Table", 1, "B6" ', "Новый"' необязательный аргумент
    'вместо SQL конструкции "select * from..." подставить имя таблицы, запроса или свою конструкцию
End Sub
Public Sub btnSvod(strPathofTmpl$, strNameofTblQry$, iNSH%, sDist$, Optional vrNofSh$)
'strPathofTmpl - имя вместе с путем файла шаблона
'strNameofTblQry - имя сохраненного запроса
'iNSH - номер листа книги в файле шаблона
'vrNofSh - новое имя листа книги шаблона, если null - имя остается старым
Dim db As dao.Database 'подключение и рекордсет можут быть использованы ADO
Dim rst As dao.Recordset
Dim xlAPP As Excel.Application
Dim xlBook As Excel.Workbook, xlSheet As Excel.Worksheet
'Dim vArr() As Variant ' массив использоваться не будет
Set db = CurrentDb()
'DoCmd.RunMakro "Svod" эта строка очевидно открывает рекордсет
Set rst = db.OpenRecordset(strNameofTblQry) ' лучше открывать подобным образом
'передавать рекордсет в массив и затем обрабатывать его и транспонировать, нет необходимости
'vArr = rst.GetRows(rst.RecordCount)
Set xlAPP = New Excel.Application
xlAPP.Visible = True
'Set xlBook = xlAPP.Workbooks.Open("FNShablon.xls ") ' путь должен быть полным!
Set xlBook = xlAPP.Workbooks.Open(strPathofTmpl)
'Set xlSheet = xlBook.Worksheets("Лист 1")
Set xlSheet = xlBook.Worksheets(iNSH) 'обращение  к листу не по имени, а по индексу
xlSheet.Range(sDist).CopyFromRecordset rst ' эта строка "перекладывает" рекордсет на лист
'If Not IsNull(vrNofSh) Then xlSheet.Name = CStr(vrNofSh) 'отказывайтесь от работы с Variant
If Not Len(vrNofSh) = 0 Then xlSheet.Name = vrNofSh ' и конструкция будет менее ресурсоемка
rst.Close:      Set rst = Nothing:      Set db = Nothing
Set xlSheet = Nothing:  Set xlBook = Nothing:   Set xlAPP = Nothing
End Sub

избавьте его от лишних коментариев и он станет не таким большим, но по прежнему будет работоспособным.
Евгений.

[sahtheey]

Пасиб,Евгений!

[sahtheey]

Помогите довести до ума! При нажатии кнопки на меню у меня открывается готовый шаблон xls. Мне теперь остается заполнить его, то есть данные которые лежат в таблице должны перекинутся на лист xls.

Вот эта строка команды не выполняется.
xlSheet.Range(sDist).CopyFromRecord set rst ' эта строка "перекладывает" рекордсет на лист

Придется через массив вытаскивать? У кого какие варианты?????

А код проги такова(xls. открывается, правда пустой лист):

Public Sub btnSvod()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim PathName As String
Dim FNShablon As String

Dim sgr, st1 As String
Dim i As Long
Dim rowNum As Long

Set db = CurrentDb
Set rst = db.OpenRecordset("select * from Svod_rezult")
Set xlapp = New Excel.Application
xlapp.Visible = True

PathName = CurrentProject.Path
FNShablon = PathName + "\FORM4_SHABLON.xls"

Set xlwkb = xlapp.Workbooks.Open(FNShablon)
Set xlsheet = xlapp.Worksheets("Лист1")

xlsheet.Range(sDist).CopyFromRecord set rst
If Not Len(vrNofSh) = 0 Then xlsheet.Name = vrNofSh
rst.Close: Set rst = Nothing: Set db = Nothing
Set xlsheet = Nothing: Set xlBook = Nothing: Set xlapp = Nothing

End Sub

[Teslenko_EA]

Здравствуйте sahtheey.
избавьте код от лишних строк и будьте внимательнее

Public Sub btnSvod()
Dim db As DAO.Database, rst As DAO.Recordset, FNShablon As String

Set db = CurrentDb
Set rst = db.OpenRecordset("select * from Svod_rezult")
Set xlapp = New Excel.Application

      FNShablon = CurrentProject.Path + "\FORM4_SHABLON.xls"

      Set xlwkb = xlapp.Workbooks.Open(FNShablon)
      Set xlsheet = xlapp.Worksheets("Лист1")

      xlsheet.Range("B2").CopyFromRecordset rst ' не было указано место назначения
      rst.Close: Set rst = Nothing: Set db = Nothing

      xlapp.Visible = True
      Set xlsheet = Nothing: Set xlBook = Nothing: Set xlapp = Nothing
End Sub

директива Option Explicit размещенная в начале модуля не позволит применять необъявленные переменные и этим избавит Вас от подобных проблем в будущем.
Евгений.
P.S. для удобочитаемости, выкладываемый на странице код заключайте в тэги [соde]... ...[/соde].