基于Power pivot在Excel 2013中创建数据透视表,但不在Excel 2010中创建

时间:2015-11-17 10:57:55

标签: excel vba excel-vba powerpivot

以下代码适用于Excel 2013,但并不总是适用于Excel 2010.它会在set pvtSource上引发错误。

错误是:

  

错误引用“运行时错误'-2147417848(80010108)':方法   对象'pivotcache'的'createpivottable'失败了。 “

有时它可以在不抛出错误的情况下工作。我无法弄清楚为什么或如何对此代码进行故障保护。

'Create temp sheet
Dim wksSource As Worksheet
Set wksSource = wbkSource.Sheets.Add(After:=Sheets(Worksheets.Count))

'Create new cache
Dim pvcSource As PivotCache
Dim pvtSource As PivotTable
If Application.Version = "15.0" Then
    'Create pivot cache
    Set pvcSource = wbkSource.PivotCaches.Create( _
    SourceType:=xlExternal, _
    SourceData:=ActiveWorkbook.Connections("ThisWorkbookDataModel"), _
    Version:=5)

    wbkSource.Activate
    wksSource.Activate

    'Create PivotTable
    Set pvtSource = pvcSource.CreatePivotTable( _
    TableDestination:=ActiveCell, _
    DefaultVersion:=5)

ElseIf Application.Version = "14.0" Then
    'Create pivot cache
    Set pvcSource = wbkSource.PivotCaches.Create( _
    SourceType:=xlExternal, _
    SourceData:=ActiveWorkbook.Connections("ThisWorkbookDataModel"), _
    Version:=xlPivotTableVersion14)

    wbkSource.Activate
    wksSource.Activate

    'Create PivotTable
    Set pvtSource = pvcSource.CreatePivotTable( _
    TableDestination:=ActiveCell, _
    DefaultVersion:=xlPivotTableVersion14)

End If

2 个答案:

答案 0 :(得分:2)

VBA脚本显式不支持Excel 2010的Power Pivot。

答案 1 :(得分:1)

此处,Pivot缓存是从名为Named_Range的工作表中名为Sheet_Name的范围创建的,我将其留给您重命名以满足您的需要! ;)

Sub Test_Gring()
Dim wB As Workbook, _
    wS As Worksheet, _
    pC As PivotCache, _
    pT As PivotTable, _
    bCreated As Boolean

For Each wS In wB.Sheets
    For Each pT In wS.PivotTables
        If Not bCreated Then
            pT.ChangePivotCache wB.PivotCaches.Create(SourceType:=xlDatabase, _
                                      SourceData:="'Sheet Name'!" & Range("Named_Range").Address, _
                                      Version:=xlPivotTableVersion14)   'xlPivotTableVersion12
            Set pC = pT.PivotCache
            bCreated = True
        Else
            If pT.CacheIndex <> pC.Index Then pT.CacheIndex = pC.Index
        End If
    Next pT
Next wS

'Save to delete unused Pivot Caches
wB.Save
End Sub