如何修改PowerPoint图表的数据显示区域？VBA脚本求助

你的问题核心是：仅将数据粘贴到图表的数据源工作表，但未重新指定图表的数据引用范围，导致图表仍使用旧的区域，无法展示新数据。以下是修改后的完整代码，附带关键步骤说明：

关键修改点 #

• 粘贴数据后，重新定义图表的SetSourceData范围，匹配新粘贴的数据区域
• 操作图表数据源时关闭自动更新，提升运行效率
• 处理完成后关闭数据源工作簿，避免残留进程

修改后的代码 #

Private Sub CommandButton1_Click()
    Dim r As Range
    Dim powerpointapp As Object
    Dim mypresentation As Object
    Dim myslide As Object
    Dim titlesh As Object
    Dim tdate As String
    Dim chartsh As Object
    Dim chartDataWB As Object
    Dim chartDataWS As Object
    
    tdate = Format(Date, "mmmm dd, yyyy")
    ppath = "path to ppt" ' 替换为你的PPT文件路径
    
    ' 启动PPT并打开演示文稿
    Set powerpointapp = CreateObject(class:="PowerPoint.Application")
    Set mypresentation = powerpointapp.Presentations.Open(ppath)
    
    ' 更新幻灯片1的日期标题
    Set myslide = mypresentation.Slides(1)
    Set titlesh = myslide.Shapes("Dateh")
    titlesh.TextFrame.TextRange.Text = tdate
    
    ' 处理幻灯片2的图表
    Set myslide = mypresentation.Slides(2)
    Set chartsh = myslide.Shapes("Chart 6")
    
    ' 获取图表的数据源工作簿和工作表
    Set chartDataWB = chartsh.Chart.ChartData.Workbook
    Set chartDataWS = chartDataWB.Sheets(1)
    
    ' 关闭自动更新，避免频繁刷新卡顿
    chartsh.Chart.ChartData.Activate
    Application.ScreenUpdating = False
    
    ' 清空旧数据并粘贴新数据
    chartDataWS.Cells.Clear
    Set r = ThisWorkbook.Worksheets("Weekly Tracking").Range("B84:C158")
    chartDataWS.Range("A2").Resize(r.Rows.Count, r.Columns.Count).Value = r.Value
    
    ' 重新设置图表的数据源范围（关键步骤）
    ' 假设A列是类别，B列是数据，根据你的实际结构调整
    Dim newDataRange As Range
    Set newDataRange = chartDataWS.Range("A2:B" & chartDataWS.Cells(chartDataWS.Rows.Count, "A").End(xlUp).Row)
    chartsh.Chart.SetSourceData Source:=newDataRange
    
    ' 关闭数据源工作簿并保存PPT（可选，根据需求添加）
    chartDataWB.Close SaveChanges:=True
    mypresentation.Save
    
    ' 恢复设置并显示PPT
    Application.ScreenUpdating = True
    powerpointapp.Visible = True
    powerpointapp.Activate
    Application.CutCopyMode = False
    
    ' 释放对象
    Set newDataRange = Nothing
    Set chartDataWS = Nothing
    Set chartDataWB = Nothing
    Set chartsh = Nothing
    Set myslide = Nothing
    Set mypresentation = Nothing
    Set powerpointapp = Nothing
End Sub

额外说明 #

• 如果你的图表有多个系列，需要调整SetSourceData的范围，确保包含所有系列数据
• 若PPT图表的数据源结构有变化（比如新增列），需对应修改数据粘贴和数据源范围的定义
• 建议添加错误处理（如On Error Resume Next或On Error GoTo），避免因文件路径错误、图表名称不存在等问题导致脚本崩溃

内容的提问来源于stack exchange，提问作者Venkata Krishna Yaswanth Matur