如何批量修改PPT中ThinkCell条形图的Excel数据源链接路径？

• ThinkCell批量替换功能
  1. 打开复制好的目标PPT，按Ctrl+A全选页面内容，再手动筛选保留所有ThinkCell条形图（或者直接在ThinkCell工具栏里找到「Select All Charts」选项一键选中所有图表）
  2. 切换到ThinkCell的「Data」选项卡，点击「Change Data Source」按钮
  3. 在弹出的文件选择窗口中选中新的Excel文件，由于两个文件的工作表、表格结构完全一致，ThinkCell会自动匹配对应的数据区域，确认后就能完成所有图表的数据源批量切换
• PPT文件底层路径替换
  1. 把复制后的PPT文件后缀从.pptx改成.zip，右键解压到任意文件夹
  2. 打开解压后的ppt/slides目录，里面是所有幻灯片对应的.xml文件
  3. 用支持批量替换的文本编辑器（比如Notepad++）打开所有.xml文件，查找旧Excel文件的完整路径（例如D:\Old_Report_Data.xlsx），替换为新Excel文件的完整路径
  4. 替换完成后，把所有文件重新打包成.zip格式，再改回.pptx后缀，打开PPT即可生效

以下宏代码可以批量遍历PPT里的所有ThinkCell图表，自动替换数据源路径：

Sub BatchUpdateThinkCellData()
    Dim currPPT As Presentation
    Dim sld As slide
    Dim shp As shape
    Dim oldExcelPath As String
    Dim newExcelPath As String
    
    ' 替换成你的旧/新Excel文件完整路径
    oldExcelPath = "D:\Old_Report_Data.xlsx"
    newExcelPath = "D:\New_Report_Data.xlsx"
    
    Set currPPT = ActivePresentation
    
    For Each sld In currPPT.Slides
        For Each shp In sld.Shapes
            ' 识别ThinkCell图表（名称以TC开头）
            If Left(shp.Name, 2) = "TC" Then
                ' 替换数据源路径
                shp.Tags("TCDataSource").Value = Replace(shp.Tags("TCDataSource").Value, oldExcelPath, newExcelPath)
            End If
        Next shp
    Next sld
    
    MsgBox "所有图表数据源已批量更新！"
End Sub

• 使用步骤：
  1. 打开目标PPT，按Alt+F11打开VBA编辑器
  2. 右键点击左侧的PPT项目，选择「插入」→「模块」，把上面的代码粘贴进去
  3. 修改代码里的oldExcelPath和newExcelPath为实际的文件路径
  4. 点击工具栏的「运行」按钮，等待宏执行完成即可

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