应用程序定义错误创建新数据透视表

时间:2017-06-19 14:50:41

标签: excel vba excel-vba

嗨,这个宏在一张excel表上工作,但是当我在excel表的同一副本上尝试使用它时,我遇到了应用程序定义/对象定义的错误。我正在尝试使用动态范围在新工作表上创建数据透视表。在修复我的代码时,我们将不胜感激。

Sub CreatePivot()

Dim wsNew As Worksheet
Set wsNew = Sheets.Add
ActiveSheet.Name = "Pivot"

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Report!" & Sheets("Report").Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1), Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:=wsNew.Name & "!R3C1", TableName:="PivotTable4", DefaultVersion _ 
:=xlPivotTableVersion15

当我运行调试时,我收到错误:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Report!"

1 个答案:

答案 0 :(得分:0)

请尝试下面的动态代码,将代码中的PivotTable解释为注释:

Option Explicit

Sub CreatePivot()

Dim PvtCache            As PivotCache
Dim PvtTbl              As PivotTable
Dim wsNew               As Worksheet
Dim SrcRng              As Range

' add a new worksheet and name it "Pivot"
Set wsNew = Sheets.Add
ActiveSheet.Name = "Pivot"

' set the Source range of the Pivot Cache
Set SrcRng = Sheets("Report").Range("A1").CurrentRegion

' set Pivot Cache for Pivot Table
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcRng.Address(True, True, xlA1, xlExternal))

' === for DEBUG Only ===
Debug.Print SrcRng.Address(True, True, xlA1, xlExternal)

' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl = wsNew.PivotTables("PivotTable4") ' check if "PivotTable4" Pivot Table already created (in past runs of this Macro)

On Error GoTo 0
If PvtTbl Is Nothing Then ' Pivot table object is nothing >> create it

    ' create a new Pivot Table in "PivotTable4" sheet
    Set PvtTbl = wsNew.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=wsNew.Range("A3"), TableName:="PivotTable4")

    With PvtTbl
        ' modify the resy of the Pivot-Table properties

    End With
Else
    ' just refresh the Pivot cache with the updated Range
    PvtTbl.ChangePivotCache PvtCache
    PvtTbl.RefreshTable
End If

End Sub