来自同一数据透视表错误的多个数据透视表

debugcn 发表于 Dev

卢卡斯

尝试将第二个数据透视表添加到相同的数据透视表缓存时，出现错误“应用程序定义的错误或对象定义的错误”。该代码在不同于创建数据透视表的工作簿上运行。（Excel 2016年）

Public Sub exportFA()

    Dim ExportWbk As Workbook
    Dim sExportPath As String
    Dim sTargetWS As Worksheet
    Dim oFAConn As WorkbookConnection
    Dim pt As PivotTable
    Dim pc As PivotCache


    'connect to an existing excel workbook. It has an excel table that will be the source for pivots.
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    If Application.FileDialog(msoFileDialogOpen).Show = -1 Then
        'copy file path to text box
        sExportPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    Else
        Exit Sub
    End If
        
    If Trim(sExportPath) = "" Then Exit Sub

    Set ExportWbk = Workbooks.Open(sExportPath, False, False)

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Set sTargetWS = ExportWbk.Sheets.Add(After:=ExportWbk.Worksheets(ExportWbk.Worksheets.Count))
    sTargetWS.Name = "FinancialAnalysis"

    ThisWorkbook.Activate

    'Create a workbook connection to an excel table
    Set oFAConn = ExportWbk.Connections.Add2( _
        "FA_Connection", "", _
        "WORKSHEET;" & sExportPath _
        , ExportWbk.Name & "!tblCombinedAccounting_FA", 7, True, False)

    'Create the pivot cache to be used by the FA tables
    Set pc = ExportWbk.PivotCaches.Create(SourceType:=xlExternal, SourceData:=oFAConn, Version:=6)

   'Setup first pivot. This works fine.
   Set pt = pc.CreatePivotTable(TableDestination:=ExportWbk.Sheets("FinancialAnalysis").Range("C3"), 
   TableName:="ptFA_1", DefaultVersion:=6)

   Call SetupPivot(pt,1) 'setup the fields of the pivot. This is irrelevant as skipping it and placing the second pivot table somewhere else on the sheet still raises an error

   '!!!!!!this raises the error
   Set pt = pc.CreatePivotTable(TableDestination:=ExportWbk.Sheets("FinancialAnalysis").Range("C" & 
   pt.RowRange.End(xlDown).Row + 10), TableName:="ptFA_2", DefaultVersion:=6)

   ' I also tried a different add method, but I get the same error:
   Set pt = ExportWbk.Sheets("FinancialAnalysis").PivotTables.Add(PivotCache:=pc, TableDestination:=ExportWbk.Sheets("FinancialAnalysis").Range("C100"), TableName:="ptFA_2")

脑电图

似乎在添加PivotTables到Data Modela时PivotCache需要为每个创建一个PivotTable。若要测试此PivotTables，请Table在录制宏时从同一位置创建两个。确保选中该框Add this data to the Data Model或Use this workbook's Data Model。您会在记录的宏中看到在两种情况下PivotCache都创建了a ，但是两者都PivotTables可以通过common进行“控制”Slicer。

建议的解决方案：此解决方案适用于PivotTables添加到中Data Model。

Public Sub PivotTables_Add_ToDataModel()
Const kCntNme As String = "Cnt_DataModel"   'Connection Name
Const kConnct As String = "WORKSHEET;#PTH"  'ConnectionString
Const kCmdTxt As String = "#WBK!#TBL"       'CommandText
Dim sPath As String
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim Cnt As WorkbookConnection
Dim Ptb As PivotTable

    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    If Application.FileDialog(msoFileDialogOpen).Show = -1 Then
        sPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        If Trim(sPath) = vbNullString Then Exit Sub
    Else
        Exit Sub
    End If
    
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set Wbk = Workbooks.Open(sPath, False, False)
    With Wbk
        
        Set Wsh = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        Wsh.Name = "FinancialAnalysis"
    
        Rem Set DataModel Connection
        On Error Resume Next
        Set Cnt = .Connections(kCntNme)
        On Error GoTo 0
        If Cnt Is Nothing Then
            Set Cnt = .Connections.Add2(kCntNme, kCntNme, Replace(kConnct, "#PTH", sPath), _
                Replace(Replace(kCmdTxt, "#WBK", .Name), "#TBL", "tblCombinedAccounting_FA"), xlCmdExcel, True, False)
        End If
    
        Rem Set 1st PivotTable
        Set Ptb = .PivotCaches.Create(SourceType:=xlExternal, SourceData:=.Connections(kCntNme), Version:=6) _
                    .CreatePivotTable(TableDestination:=Wsh.Range("C3"), TableName:="ptFA_1", DefaultVersion:=6)
        
        Rem Set 2nd PivotTable
        Set Ptb = .PivotCaches.Create(SourceType:=xlExternal, SourceData:=.Connections(kCntNme), Version:=6) _
                    .CreatePivotTable(TableDestination:=Wsh.Range("C100"), TableName:="ptFA_2", DefaultVersion:=6)
    
    End With
    
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。