Отчет из access в шаблон xltm при открытой базе

[R Dmitry]

Сообщение от mrs.petrushina

R Dmitry, работает, кртуо!!!!! спасибо огромное!
может посмотришь мой второй варинт решения проблемы (http://programmersforum.ru/showthread.php?t=145385), т.к. хотелось бы еще от исходных данных избавиться, мне только сводные в результатном файле нужны. Отчетов у меня порядка десятка, поэтому технология для меня важна.

Замените этот блок, и все останеться в кэше сводной

With app.ActiveWorkbook.Sheets(1)
'Заполнение шаблона
.Visible = False
.[a1].CurrentRegion.Offset(1, 0).ClearContents
.[a2].Resize(UBound(arr, 2) + 1, UBound(arr) + 1) = app.Application.Transpose(arr)
app.ActiveWorkbook.RefreshAll
app.ActiveWorkbook.Sheets(2).Activate
.[a1].CurrentRegion.Offset(1, 0).ClearContents
'Debug.Print UBound(arr, 2) & "*" & UBound(arr)
End With

по этому принципу хоть 20 сводных , места в excel хоть отбавляй

[mrs.petrushina]

ошибку выдавать стало((

[R Dmitry]

у меня не выдает проверил на 2003 и 2010
с коментариями

Option Compare Database
Sub CreateReport()
 Dim app As Excel.Application
 Dim dba As Database, arr(), rs As Recordset, strSql$
Set dba = CurrentDb()
strSql = "Select* From 0110_Запрос_для_SMS_fin;"
Set rs = dba.OpenRecordset(strSql)
On Error GoTo err_rep
 rs.MoveLast: rs.MoveFirst
 'массив с 0 строки (столбцы,строки)
arr = rs.GetRows(rs.RecordCount)
 Dim strDOT As String
 '+++++++++++++++++++++++++++++++++++++++++
 'если шаблон в одной папке с access
    With Application.CurrentProject
     strDOT = .Path & "\" & "sms.xlt"
    End With
'++++++++++++++++++++++++++++++++++++++++++
'strDOT = "C:\Users\Олег\Desktop\Ежедневный_СМС_отчет.xltm"
Set app = New Excel.Application
app.Visible = True
app.Workbooks.Add strDOT
With app.ActiveWorkbook.Sheets(1)

'Заполнение шаблона
.Visible = False ' скрываем лист с данными можно сразу скрыть в шаблоне ручками
.[a1].CurrentRegion.Offset(1, 0).ClearContents ' очищаем таблицу данных

'очищаем программно кеш от старых данных (очищает все сводные таблицы на листе)******
For i = 1 To app.Sheets(2).PivotTables.Count
app.Sheets(2).PivotTables(i).PivotCache.MissingItemsLimit = xlMissingItemsNone
Next
'******************************************************

'загружаем данные в лист excel
.[a2].Resize(UBound(arr, 2) + 1, UBound(arr) + 1) = app.Application.Transpose(arr)
'обновляем все данные
app.ActiveWorkbook.RefreshAll
' активируем нужный лист (На всякий случай)
app.ActiveWorkbook.Sheets(2).Activate

End With
Exit Sub
err_rep: MsgBox "error"
End Sub

[mrs.petrushina]

Оказывается, у меня библиотека другая excel была и конфликтовала с той, что у тебя=) Исправила и получилось!!! урра!!!
R Dmitry, можно мне тебя в скайп добавить и иногда приставать с дурацкими вопросами?

[R Dmitry]

Сообщение от mrs.petrushina

Оказывается, у меня библиотека другая excel была и конфликтовала с той, что у тебя=) Исправила и получилось!!! урра!!!
R Dmitry, можно мне тебя в скайп добавить и иногда приставать с дурацкими вопросами?

можно, буду там завтра