xml - 从 powerpoint 幻灯片中检索 Excel 图表数据(以编程方式)

Question

背景

在 PowerPoint 中工作时，我总是使用直接位于图表后面的 Excel 电子表格，并链接到源工作簿。此方法可确保:

1. 文件背后的数据源易于识别(链接到网络)。
2. 如果需要，可以直接编辑 PowerPoint 文件。
3. 可以通过将基础电子表格重新链接到源工作簿来针对新场景更新图表。

问题

最近我遇到了一个 PowerPoint 文件，我需要使用该文件来创建新图表。不知何故，即使图表是使用我上面描述的方法创建的，也无法访问底层数据。我不希望我的团队手动检索数据，因此我寻找一种方法，以便在这种情况再次发生时可以再次使用。

第一种方法

我最终遵循了magicbeanlab中概述的方法。其中涉及:

• 将 PPT 文件剪切为单张幻灯片(带有我想要的图表)。
• 将 PPT 文件重命名为 zip。
• 导航到 /ppt/charts/ 目录以获取 xml 格式的图表。
• 打开 xml 文件可以访问数据，但这只是大量其他信息之一。

问题

什么是更好的方法(自动 XML 检索)或使用 VBA 获取图表数据以在其他地方使用？

Answer 1

Andy Pope提供了这个答案，它将数据从 PowerPoint 图表提取到剪贴板。

此时可以直接将其拖回Excel中。

安迪干得好。

Sub RipChartValues()

Dim cht As PowerPoint.Chart
Dim seriesIndex As Long
Dim labels As Variant
Dim values As Variant
Dim name As String
Dim buffer As String
Dim objData As Object

Set cht = ActiveWindow.Selection.ShapeRange.Parent.Shapes(ActiveWindow.Selection.ShapeRange.name).Chart

With cht
    For seriesIndex = 1 To .SeriesCollection.Count
    name = .SeriesCollection(seriesIndex).name
    labels = .SeriesCollection(seriesIndex).XValues
    values = .SeriesCollection(seriesIndex).values

    If seriesIndex = 1 Then buffer = vbTab & Join(labels, vbTab) & vbCrLf
    buffer = buffer & (name & vbTab & Join(values, vbTab) & vbCrLf)
    Next

End With

On Error Resume Next
' Rory's late bind example
' this is a late bound MSForms.DataObject
Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

' copy current cell formula to clipboard
With objData
    .SetText buffer
    .PutInClipboard
    MsgBox "Data extracted to clipboard!", vbOKOnly, "Success"
End With

End Sub