使用VBA修改现有PowerPoint图表的数据范围问题

首先，咱们拆解下你遇到的核心问题：新建图表时能用ListObjects.Resize调整数据范围，但现有图表不行，这大概率是因为现有PPT图表的数据源并没有使用ListObject（Excel结构化表格），而AddChart2创建的新图表默认会自动生成绑定的ListObject，两种场景的数据源结构完全不同。

先优化你的图表查找代码 #

你当前的查找代码存在重复定义Dim myChart的问题，而且硬循环到1000的效率很低，换成遍历幻灯片所有Shapes的方式更稳妥：

Dim ppSlide As PowerPoint.Slide
Dim myChart As PowerPoint.Chart
Dim shp As PowerPoint.Shape

' 假设你已获取目标幻灯片对象ppSlide
For Each shp In ppSlide.Shapes
    If shp.HasChart Then
        Set myChart = shp.Chart
        Exit For ' 找到第一个图表就退出，需处理多个图表可删除此句
    End If
Next shp

为什么现有图表的Resize代码无效？ #

用AddChart2新建图表时，PowerPoint会自动在关联的ChartData工作簿里创建一个ListObject，所以myWks.ListObjects(1)能找到对象并执行Resize。但现有图表的数据源可能只是普通单元格区域，没有绑定ListObject，这时候调用ListObjects(1)要么因On Error Resume Next被忽略错误，要么根本找不到对象，自然Resize无效。

不依赖ListObject的通用解决方案（适配现有图表） #

既然不想链接到源Excel，我们需要完全独立地更新图表数据源，步骤如下：

1. 打开图表关联的ChartData工作簿（确保独立无链接）
2. 清空原有数据区域
3. 逐单元格写入新数据（避免粘贴产生链接）
4. 直接调整图表的数据源范围

完整代码示例：

Dim myChart As PowerPoint.Chart
Dim myData As PowerPoint.ChartData
Dim myWkb As Excel.Workbook
Dim myWks As Excel.Worksheet
Dim sourceWks As Excel.Worksheet
Dim rowct As Integer, colct As Integer
Dim targetRange As Excel.Range

' 指向源数据工作表（你的Excel工具中的Acc_Data）
Set sourceWks = Workbooks("ppt-tool.xlsm").Sheets("Acc_Data")
' 假设已通过优化后的查找代码获取目标图表myChart

' 必须先激活ChartData工作簿才能编辑
myChart.ChartData.Activate
Set myData = myChart.ChartData
Set myWkb = myData.Workbook
Set myWks = myWkb.Worksheets(1)

' 1. 清空原有数据（若需保留表头可调整为清空数据行）
myWks.Cells.Clear

' 2. 获取源数据的有效行列数（假设数据从A1开始）
rowct = sourceWks.Cells(sourceWks.Rows.Count, 1).End(xlUp).Row
colct = sourceWks.Cells(1, sourceWks.Columns.Count).End(xlToLeft).Column

' 3. 逐单元格赋值，避免产生链接
For j = 1 To rowct
    For i = 1 To colct
        myWks.Cells(j, i).Value = sourceWks.Cells(j, i).Value
    Next i
Next j

' 4. 直接设置图表的数据源范围
Set targetRange = myWks.Range(myWks.Cells(1, 1), myWks.Cells(rowct, colct))
myChart.SetSourceData Source:=targetRange

' 关闭并保存ChartData工作簿（避免弹窗且确保数据写入）
myWkb.Close SaveChanges:=True

关键注意点 #

• 避免链接：采用单元格Value赋值而非粘贴操作，确保图表数据源独立，不会和ppt-tool.xlsm绑定，即使工具后续不保存数据，PPT图表数据依然留存。
• 必须激活ChartData：编辑PPT图表数据源前，必须调用myChart.ChartData.Activate，否则无法访问关联的Excel工作簿。
• 兼容多图表场景：若幻灯片有多个图表，将上述逻辑嵌入遍历Shapes的循环即可逐个处理。

额外优化：兼容有/无ListObject的场景 #

如果你不确定现有图表是否存在ListObject，可以添加判断逻辑，同时适配两种情况：

Dim lo As Excel.ListObject
On Error Resume Next
Set lo = myWks.ListObjects(1)
On Error GoTo 0

If Not lo Is Nothing Then
    ' 存在ListObject时用Resize调整
    Dim dat_area As String
    dat_area = "A1:" & myWks.Cells(rowct, colct).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    lo.Resize myWks.Range(dat_area)
Else
    ' 无ListObject时直接设置数据源
    Set targetRange = myWks.Range(myWks.Cells(1, 1), myWks.Cells(rowct, colct))
    myChart.SetSourceData Source:=targetRange
End If

这样不管是现有图表还是新建图表，都能正常调整数据范围了。

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