Retrieve Excel-Diagrammdaten aus Powerpoint-Folie (programmatisch)

Question

Hintergrund

Wenn in Powerpoint arbeitet ich immer eine Excel-Tabelle verwenden, die direkt hinter dem Diagramm, und Links zu einer Quelle Arbeitsmappe sitzt. Diese Methode stellt Folgendes sicher:

1. Die Datenquelle hinter der Datei ist leicht identifizierbar (Verbindung zum Netzwerk).
2. Die PowerPoint-Datei kann bei Bedarf direkt bearbeitet werden.
3. Das Diagramm kann für ein neues Szenario aktualisiert werden, indem das zugrunde liegende Arbeitsblatt erneut mit der Quellarbeitsmappe verknüpft wird.

Ausgabe

Vor kurzem stieß ich auf eine Powerpoint-Datei, die ich die Daten zu verwenden, benötigen ein neues Diagramm zu erstellen. Obwohl das Diagramm mit der oben beschriebenen Methode erstellt wurde, konnte auf die zugrunde liegenden Daten nicht zugegriffen werden. Ich wollte nicht, dass meine Gruppe die Daten manuell abruft, also suchte ich nach einer Methode, die ich wiederverwenden konnte, wenn die Situation wieder auftrat.

erster Ansatz

I nach dem Ansatz auf magicbeanlab umrissenen endete, die beteiligt: ​​

• die PPT-Datei auf eine einzelne Folie Schneiden (mit dem Diagramm I wollte).
• Umbenennen der PPT-Datei als zip.
• Navigieren zum Verzeichnis /ppt/charts/, um das Diagramm in xml Format zu erhalten.
• Öffnen der xml Datei zur Verfügung gestellt Zugriff auf die Daten, aber das war unter einem Meer von anderen Informationen.

Frage

Was ist eine bessere Methode (Automatisierung des XML-Retrieval) oder VBA unter Verwendung der Kartendaten zu erhalten, an anderer Stelle zu verwenden?

Answer 1

Andy Pope diese Antwort zur Verfügung gestellt, die extrahiert die Daten aus einer PowerPoint-Tabelle in die Zwischenablage.

An dieser Stelle kann direkt in Excel zurückgesichert werden.

Gute Arbeit Andy.

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