Excel VBA从数据透视表创建图表时SetSourceData方法报错原因排查

问题描述 #

在Excel中执行「从数据透视表创建图表」的VBA代码时，触发运行时错误**-2147467259 (80004005)**，提示「对象「_Chart」的「SetSourceData」方法执行失败」。代码如下：

Sub CreateChartsFromPivotTables()
    
    Dim sh As Shape
    Dim ws As Worksheet
    Dim ch As Chart
    Dim ptPicker As PivotTable
    Dim ptSupDept As PivotTable
    Dim ptTypeOfUse As PivotTable
    Dim rngData As Range
    
    Set ws = Worksheets("DashBoard")
    Set ptPicker = ws.PivotTables("PivotPicker")
    Set ptSupDept = ws.PivotTables("PivotSupDept")
    Set ptTypeOfUse = ws.PivotTables("PivotTypeOfUse")
    
    Set rngData = ptSupDept.TableRange1
    
    Set sh = ws.Shapes.AddChart2( _
             XlChartType:=XlChartType.xlPie, _
             Left:=ws.Cells(7, 2).Left, _
             Top:=ws.Cells(7, 2).Top, _
             Width:=250, _
             Height:=200)
    
    Set ch = sh.Chart
    
    With ch
        .SetSourceData Source:=rngData
        .SeriesCollection(1).ApplyDataLabels Type:=xlShowPercent, AutoText:=True, LegendKey:=False, HasLeaderLines:=False
        .SeriesCollection(1).DataLabels.NumberFormat = "0.00%"
    End With
    
    Debug.Print rngData.Address
    
End Sub

场景说明：

• 目标：通过VBA基于「DashBoard」工作表中的三个数据透视表（PivotPicker、PivotSupDept、PivotTypeOfUse）动态创建图表
• 问题：调用.SetSourceData时报错，图表无法正常生成

可能的报错原因及解决方法 #

1. 透视表数据范围不符合饼图要求 #

饼图要求数据源至少包含1个分类列+1个数值列，如果ptSupDept.TableRange1返回的范围不符合这个结构，就会触发错误。比如：

• 透视表只有行标签或只有数值，没有成对的分类和数值
• 透视表包含多个数值字段，导致数据源结构混乱

解决方法：

• 检查ptSupDept的字段布局，确保有且仅有一组分类（行/列标签）和数值字段
• 可以改用ptSupDept.DataBodyRange配合行标签范围来精准指定数据源，示例代码：

  ' 假设行标签在第一列，数值在第二列
  Set rngData = Union(ptSupDept.RowRange, ptSupDept.DataBodyRange)
  

2. 透视表处于刷新或未就绪状态 #

如果透视表正在后台刷新，或者数据尚未完全加载，TableRange1可能返回无效范围，导致.SetSourceData失败。

解决方法：

• 在获取范围前强制刷新透视表，示例代码：

  ptSupDept.RefreshTable
  DoEvents ' 等待刷新完成
  Set rngData = ptSupDept.TableRange1
  

3. 图表创建时的默认数据干扰 #

使用AddChart2创建饼图时，Excel可能会自动添加默认的示例数据系列，此时调用.SetSourceData可能因冲突报错。

解决方法：

• 在设置源数据前清空图表的现有系列，示例代码：

  With ch
      ' 先删除所有默认系列
      Do While .SeriesCollection.Count > 0
          .SeriesCollection(1).Delete
      Loop
      .SetSourceData Source:=rngData
      ' 后续格式设置代码...
  End With
  

4. 工作表或透视表名称错误 #

如果DashBoard工作表名称拼写错误，或者PivotSupDept透视表名称不存在，Set ptSupDept = ws.PivotTables("PivotSupDept")会返回空对象，后续TableRange1自然无效。

解决方法：

• 核对工作表和透视表的名称，确保与代码中的字符串完全一致（注意大小写、空格）
• 可以添加错误检查，示例代码：

  On Error Resume Next
  Set ptSupDept = ws.PivotTables("PivotSupDept")
  On Error GoTo 0
  If ptSupDept Is Nothing Then
      MsgBox "透视表PivotSupDept不存在"
      Exit Sub
  End If
  

5. 数据透视表为空 #

如果ptSupDept没有任何数据（比如筛选后无结果），TableRange1可能只包含表头，没有有效数据行，无法生成饼图。

解决方法：

• 检查透视表是否有数据，添加判断，示例代码：

  If ptSupDept.DataBodyRange Is Nothing Then
      MsgBox "透视表PivotSupDept无数据"
      Exit Sub
  End If
  

内容的提问来源于stack exchange，提问作者Natthapat Punthumek