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

时间:2016-04-16 07:38:05

标签: xml excel vba powerpoint

背景

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

  1. 文件背后的数据源很容易识别(链接到网络)。
  2. 如果需要,可以直接编辑PowerPoint文件。
  3. 可以通过将基础电子表格重新链接到源工作簿来更新新方案的图表。
  4. 问题

    最近我遇到了一个PowerPoint文件,我需要使用该数据来创建新图表。不知何故,即使使用上述方法创建了图表,也无法访问基础数据。我不希望我的小组手动检索数据,所以我找了一个方法,如果情况再次出现,我可以再次使用。

    第一种方法

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

    • 将PPT文件剪切为单张幻灯片(使用我想要的图表)。
    • 将PPT文件重命名为 zip
    • 导航至/ppt/charts/目录以获取 xml 格式的图表。
    • 打开 xml 文件,提供对数据的访问权限,但这是其他信息之一。

    问题

    什么是更好的方法(自动化XML检索)或使用VBA获取要在别处使用的图表数据?

1 个答案:

答案 0 :(得分:3)

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