Здравствуйте форумчане!
Прошу помощи, так как сам уже неделю мучаюсь и не пойму в чем дело!
Краткая история:
У меня есть база Access, которая нормально работает вот уже несколько лет.
И вот мне приспичило добавить туда еще одну плюшку - вывод необходимой инфы в виде сводной диаграммы.
На домашнем компе (Офис 2007) добавил необходимый запрос, к нему форму (в режиме сводной диаграммы) и довольный пошел на работу. А вот на рабочем компе (Офис также 2007) оказалось, что диаграмма не работает и при попытке перевести форму в режим диаграммы Access падает полностью. Пробовал создавать новую чистую базу с тестовой таблицей и запросом - результат тот же.
После этого нарыл в инете пример передачи данных из акса в эксель, немного подогнал его под себя и получился следующий код:
Sub StajInExcel (код As Double)
On Error GoTo Err_StajInExcel
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim objPivotCache As Excel.PivotCache
Dim MyRange As Excel.Range
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient 'Рекордсет будет создан у клиента
rs.Open "SELECT First(Таблица.Дата) AS Дата, First(Таблица.Время) AS Время, Sum(Таблица.X1) AS X, Таблица.Номер1 AS [Номер] " & _
"FROM Таблица GROUP BY Таблица.Номер1, Таблица.Код, Таблица.Дата, Таблица.Время, Таблица.Номер1 HAVING (((First(Таблица.Код))=" & код & ") AND " & _
"((Count(Таблица.Код))>1) AND ((Count(Таблица.Время))>1));", _
CurrentProject.Connection, adOpenStatic, adLockReadOnly, adCmdText
Set xlApp = CreateObject("Excel.Application") 'Создание объекта MSExcel
Set xlBook = xlApp.Workbooks.Add 'Создание файла Excel
'xlApp.Visible = True 'Выводим на экран (оставлено для возможной отладки)
xlApp.DisplayAlerts = False 'Запрет возможных сообщений MSExcel
Set xlSheet = xlBook.Sheets(1)
With xlSheet
.Name = "Сводная" 'Присваивем листу имя
'Создаем сводную таблицу с внешним источником данных (xlExternal)
Set objPivotCache = xlBook.PivotCaches.Add(xlExternal)
'Присваиваем сводной таблице в качестве источника данных рекордсет (rs)
Set objPivotCache.Recordset = rs
rs.Close 'Закрываем рекордсет, т.к. он больше не нужен
Set rs = Nothing 'Чистим память от объекта
'Создаем каркас для сводной и указываем что будет строками, а что столбцами
.PivotTables.Add PivotCache:=objPivotCache, TableDestination:=.Cells(2, 1), TableName:="Svodnaya"
With .PivotTables("Svodnaya").PivotFields("Дата")
.Orientation = xlRowField 'Строка
.Position = 1 'Позиция №1
End With
With .PivotTables("Svodnaya").PivotFields("Время")
.Orientation = xlRowField 'Строка
.Position = 2 'Позиция №2
End With
With .PivotTables("Svodnaya").PivotFields("Номер")
.Orientation = xlColumnField 'Столбец
.Position = 1 'Позиция №1
End With
'Подбиваем суммы по группам
.PivotTables("Svodnaya").AddDataField .PivotTables _
("Svodnaya").PivotFields("X"), "X" ', xlSum
'=================================================================================
'Сводная таблица создана!
'=================================================================================
'=================================================================================
'Рисуем диаграмму
'=================================================================================
'Добавляем диаграмму (тип - xlColumnClustered) на новый лист
xlApp.Charts.Add
xlApp.ActiveChart.ChartType = xlColumnClustered
xlApp.ActiveChart.PlotArea.Interior.ColorIndex = xlNone 'Обесцвечиваем подложку (фон)
xlApp.ActiveChart.HasTitle = True 'Отображение заголовка диаграммы
xlApp.ActiveChart.ChartTitle.Characters.Text = "Диаграмма"
xlApp.ActiveChart.Legend.Position = xlTop 'Вывод легенды сверху диаграммы
xlApp.ActiveSheet.Name = "Диаграмма" 'Наименование листа
.Visible = xlSheetVeryHidden
End With
'Скрываем 'повылазившие' панели инструментов
xlApp.ActiveWorkbook.ShowPivotTableFieldList = False
xlApp.CommandBars("PivotTable").Visible = False
xlApp.CommandBars("Chart").Visible = False
'Сохранение файла под именем Staj.xls
xlBook.SaveAs FileName:=CurrentProject.Path & "\Staj", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
xlApp.DisplayAlerts = True 'Разрешаем сообщения MSExcel
xlApp.Visible = True 'Выводим на экран
xlApp.CalculateFull
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
Err_StajInExcel:
MsgBox Err.Description, vbCritical + vbMsgBoxHelpButton, _
"Ошибка №" & Err.number, Err.HelpFile, Err.HelpContext
On Error Resume Next
xlApp.Quit
End Sub
Этот код я также вставлял и подгонял под себя на домашнем компе - все прекрасно работает - создается файл эксель
и в нем сводная таблица и диаграмма. А на рабочем компе опять затык - Акс падает наглухо на строке:
rs.OPEN...
Проверял все References - все в порядке.
Потом попробовал этот код перенести на VB-6 (с соответствующими изменениями). Сделал небольшой exe файлик,
который при запуске из кода Access делал диаграмму в Excel. Опять тоже самое - дома работает, а на рабочем компе нет.
Уже и не знаю в какую сторону копать - почему на строке rs.OPEN Акс падает полностью?
http://www.sql.ru/forum/1091181/sozdanie-diagrammy-excel-iz-access
