循环创建数据透视表和条形图

时间:2018-06-27 16:04:09

标签: excel-vba access-vba runtime-error pivot-table pivot-chart

我正在编写一些VBA,该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

第一次迭代运行并完美保存。在第二次迭代中,我在这一行得到一个错误

ActiveChart.FullSeriesCollection(3).Select

  

运行时错误1004:对象“ _GLOBAL”的方法“活动图表”失败

我不知道为什么我不喜欢让我激活页面上的活动图表后如何选择完整系列集合。我需要重置我的变量之一吗?我是否需要选择以其他方式创建的活动图表?

任何对此的见解将不胜感激!

1 个答案:

答案 0 :(得分:1)

我提出的第一个问题与该问题无关,但是肯定会加快您的代码速度。在以下几行中:

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语句)