MS Project生成旧版Excel数据透视表致切片器失效求助

我有一段VBA代码，用于从MS Project提取数据并在Excel中创建数据透视表。尝试给这个透视表添加切片器时，切片器图标呈灰色不可用状态。查资料得知这个问题通常和Excel旧版本有关，但我订阅的是Microsoft 365，用的是最新版Excel，排查后发现生成的数据透视表是旧版本格式。以下是我添加Excel引用的代码以及创建数据透视表的代码：

添加Excel引用的代码 #

Sub AddReferenceToExcel()
'this sub adds the correct reference to excel to ensure that the export works
Dim Major As Long
Dim Minor As Long
On Error Resume Next
    Major = 1
    With ActiveProject.VBProject.References
        .Remove .Item("Excel")
        Major = 1
        For Minor = 9 To 5 Step -1
            Err.Clear
            .AddFromGuid "{00020813-0000-0000-C000-000000000046}", Major, Minor
            If Err.Number = 0 Then
                Exit For    'no error, so reference set
            End If
        Next Minor
    End With
End Sub

创建数据透视表的代码 #

'Creating Pivot table
'====================
Dim pt As PivotTable
Dim ptfield As PivotField
Dim strField As String
Dim xlSheet As Excel.Worksheet
Set xlSheet = xlAPP.Worksheets(1)
Dim PTOutput As Excel.Worksheet
Dim PTCache As PivotCache
Dim PRange As Range
Dim finalRow As Variant
Dim finalCol As Variant

'Setting Pivot Range on Sheet1
'=============================
xlSheet.Activate
' Find the last row with data
finalRow = xlSheet.Cells(xlAPP.Rows.Count, 3).End(xlUp).Row - 3
' Find the last column with data
finalCol = xlSheet.Cells(4, xlAPP.Columns.Count).End(xlToLeft).Column
' Find the range of the data
Set PRange = xlSheet.Cells(4, 1).Resize(finalRow, finalCol)
ActiveSheet.ListObjects.Add(xlSrcRange, PRange, , xlYes).Name = "T_PivotData"

Set PTOutput = xlAPP.Worksheets(3)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="T_PivotData")
'Create the pivot table
Set pt = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(20, 1), TableName:="ForecastPivotFTE")

1. Excel引用版本强制绑定旧库 #

你的AddReferenceToExcel代码循环绑定的是旧版Excel类型库（Major=1，Minor从9到5），这会强制VBA以旧版Excel兼容模式运行，直接导致生成旧格式透视表。

修复方案：改用后期绑定（推荐，彻底避免版本依赖）

删除原引用代码，改用无需手动添加引用的后期绑定方式：

Sub AddReferenceToExcel()
    ' 后期绑定Excel对象，自动适配当前安装版本
    Dim xlApp As Object
    On Error Resume Next
    Set xlApp = CreateObject("Excel.Application")
    If Err.Number <> 0 Then
        MsgBox "无法启动Excel，请检查是否安装"
        Exit Sub
    End If
    xlApp.Quit
    Set xlApp = Nothing
End Sub

如果坚持用早期绑定，直接绑定当前365版本的类型库：

Sub AddReferenceToExcel()
    Dim ref As Reference
    On Error Resume Next
    With ActiveProject.VBProject.References
        ' 移除旧引用
        Set ref = .Item("Excel")
        If Not ref Is Nothing Then .Remove ref
        ' 绑定Office 365对应的Excel类型库（Major=16）
        .AddFromGuid "{00020813-0000-0000-C000-000000000046}", 16, 0
    End With
End Sub

2. 数据透视表缓存使用旧版创建方式 #

旧版PivotCaches.Add方法默认生成兼容旧版本的透视表，改用Excel 2013+支持的PivotCaches.Create方法，并强制指定最新版本：

修复创建透视表的核心代码

' 创建新版数据透视表缓存，指定最新版本
Set PTCache = ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:="T_PivotData", _
    Version:=xlPivotTableVersionLatest)

' 创建透视表时也指定最新版本
Set pt = PTCache.CreatePivotTable( _
    TableDestination:=PTOutput.Cells(20, 1), _
    TableName:="ForecastPivotFTE", _
    Version:=xlPivotTableVersionLatest)

3. 确保数据源表格为新版格式 #

虽然你创建了ListObject，可以显式指定使用新版表格样式，进一步避免兼容问题：

ActiveSheet.ListObjects.Add(xlSrcRange, PRange, , xlYes).Name = "T_PivotData"
' 强制应用新版表格样式
ActiveSheet.ListObjects("T_PivotData").TableStyle = "TableStyleMedium2"

内容的提问来源于stack exchange，提问作者Muhammad Mateen