Цикл для создания сводных таблиц и гистограмм - PullRequest
Новая
       50

Цикл для создания сводных таблиц и гистограмм

0 голосов
/ 27 июня 2018

Я работаю над написанием некоторого VBA, который выполняется в процедуре Microsoft Access, которая открывает документ Microsoft Excel и создает сводную таблицу и гистограмму для каждого из наших заводов и инженеров. Он всегда работает для первого запуска, но всегда дает сбой, когда цикл запускает процесс снова. Мой код выглядит следующим образом: 

Sub PlantDashboard()

    Dim dbs As Database
    Dim plants As DAO.Recordset
    Dim rsquery1, rsquery2, rsquery3 As DAO.Recordset
    Dim targetworkbook As Object
    Dim wksheet1, wksheet2  As Object
    Dim prop As Office.MetaProperty
    Dim props As Office.MetaProperties

    Set dbs = CurrentDb
    Set plants = dbs.OpenRecordset("Selected Plant/SQE")
    plants.MoveFirst
    Set plant = plants.Fields("Plant")

    Do Until plants.EOF                          'Start of loop
        Set excelapp = CreateObject("excel.application", "")
        Set targetworkbook = excelapp.Workbooks.Open("H:\Plant SQE DB\Plant SQE DB - Template.xlsx")
        .
        .
        .
        Set wksheet2 = targetworkbook.worksheets("Open SQNs") 'Worksheet for pivot table and bar chart
        wksheet2.Activate
        Dim pcs As PivotCache
        Dim pts As PivotTable
        Dim pfs As PivotField

        Set rng = wksheet2.Range("A:A")          'column of vendor names placed by access query (rsquery3)
        nbropensqn = rng.SpecialCells(2).Cells.Count 'count of vendors names
        nbropensqn = nbropensqn - 2              'removes 2 headers from query from count
        wksheet2.Activate                        'maybe unnecessary to re-activate same sheet?
        wksheet2.Range("A2:E" & nbropensqn + 2).Select 'select range of data for pivot table

        Set pcs = targetworkbook.PivotCaches.Create( _
                  SourceType:=xlDatabase, _
                  SourceData:=wksheet2.Range("A2:E" & nbropensqn + 2), _
                  Version:=xlPivotTableVersion15)

        wksheet2.Activate                        'maybe unnecessary to re-activate same sheet?
        wksheet2.Range("H2").Select              'where i place the pivot table

        Set pts = pcs.CreatePivotTable( _
                  TableDestination:=wksheet2.Range("H2"))

        Set pfs = pts.PivotFields("Vendor Account Number")
        pfs.Orientation = xlRowField

        Set pfs = pts.PivotFields("Not Started")
        pfs.Orientation = xlDataField

        Set pfs = pts.PivotFields("On Time")
        pfs.Orientation = xlDataField

        Set pfs = pts.PivotFields("Late")
        pfs.Orientation = xlDataField

        Set pfs = pts.PivotFields("Count")
        pfs.Orientation = xlDataField

        wksheet2.Range("'Open SQNs'!$H$2:$L$" & nbropensqn).Select
        wksheet2.Shapes.AddChart2(297, xlBarStacked).Select

        wksheet2.ChartObjects("Chart 1").Activate
        ActiveChart.FullSeriesCollection(3).Select '**ERROR HERE**
        ActiveChart.PivotLayout.PivotTable.PivotFields("Vendor Account Number").AutoSort _
                                                       xlAscending, "Count of Vendor Account Number",     ActiveChart.PivotLayout.PivotTable. _
                                                                                                     PivotColumnAxis.PivotLines(4), 1 'Sort by Count of Supplier SQNs

        'BEGIN FORMATTING CHART
        ActiveChart.FullSeriesCollection(4).Select
        .
        .
        .
        ActiveChart.FullSeriesCollection(2).Select
        .
        .
        .
        ActiveChart.FullSeriesCollection(3).Select
        .
        .
        .
        'END FORMATTING CHART
        'SELECT COPY AND PASTE CHART TO DIFFERENT WORKSHEET
        ActiveChart.ChartArea.Select
        Selection.Copy
        wksheet1.Activate
        ActiveSheet.Range("A32").Select
        ActiveSheet.Paste

        'CONTINUE WITH REST OF CODE
        'Save and close targetworkbook
        'excelapp.Application.Quit

        plants.MoveNext                          'Move to next "plant" in plants
    Loop

End Sub

Первая итерация запускается и отлично сохраняется. На 2-й итерации я получаю ошибку в этой строке

ActiveChart.FullSeriesCollection(3).Select

ОШИБКА ВРЕМЕНИ РАБОТЫ 1004: СБОЙ МЕТОДА 'ACTIVECHART' ОБЪЕКТА '_GLOBAL'

Понятия не имею, почему не нравится, как я выбрал полную коллекцию серий после того, как позволил мне активировать активную диаграмму на странице. Нужно ли сбрасывать одну из моих переменных? Нужно ли выбирать активный график, созданный другим способом?

Любое понимание этого будет оценено!

1 Ответ

0 голосов
/ 27 июня 2018

Первая проблема, которую я поднимаю, не связана с вопросом, но, несомненно, ускорит ваш код. В следующих строках: 

Do Until plants.EOF 'Start of loop
    Set excelapp = CreateObject("excel.application", "")
    Set targetworkbook = excelapp.Workbooks.Open("H:\Plant SQE DB\Plant SQE DB - Template.xlsx")
.

Вы создаете объект Excel и открываете шаблон в каждом цикле. Зачем? В этом нет необходимости, он тратит ресурсы и увеличивает время выполнения.

Сделайте это вместо: 

Set excelapp = CreateObject("excel.application", "")
Set targetworkbook = excelapp.Workbooks.Open("H:\Plant SQE DB\Plant SQE DB - Template.xlsx")

Do Until plants.EOF 'Start of loop

Если вам нужно сохранить шаблон для каждого графика, вы можете сделать это в конце так: 

targetworkbook.SaveAs newFileName

Теперь рассмотрим проблемы с ActiveChart. Измените эти строки: 

wksheet2.Shapes.AddChart2(297, xlBarStacked).Select
wksheet2.ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(3).Select

Кому: 

Dim cht as Object
Set cht = wksheet2.Shapes.AddChart2(297, xlBarStacked)

With cht.FullSeriesCollection(3)
    ...

И следуйте примеру для всех строк ниже. Каждый раз, когда вы видите ActiveChart, перемещайте метод внутри With Statement и работайте непосредственно с объектом (исключите все операторы select)

...