Hi Forum,
vielleicht kann jemand helfen: Ich möchte aus Excel heraus die Datentabellen aus allen Diagrammen einer PowerPoint-Datei in die Excel kopieren (Office 2016). Das funktioniert im Prinzip, schlägt aber an scheinbar wahlloser Stelle immer wieder fehl. Laut Fehlermeldung ist entweder Chartdata.Workbook.Activate fehlgeschlagen oder das PasteSpecial funktioniert nicht. Es handelt sich bei mehreren Durchläufen nicht immer um dasselbe Diagramm. Alle Versuche mit Loops den fehlgeschlagenen Prozess einfach zu wiederholen funktionieren nicht. Aufgefallen ist mir nur, dass ich die jeweilige Datendatei in PowerPoint selbst öffnen kann, sie heißt dann aber nicht wie sonst "Diagramm in PowerPoint" sondern "Mappe xy". Hat jemand eine Idee, warum das instabil ist?
Vielen Dank, Marco
Sub PPTAuslesen()
Dim zeile As Integer
Dim pptApp As PowerPoint.Application
Dim ppFile As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppShape As PowerPoint.Shape
Dim ppChart As PowerPoint.Chart
Dim ppChartData As PowerPoint.ChartData
Dim wks As Excel.Worksheet
Dim ppdatawkb As Excel.Workbook
Set pptApp = GetObject(, "PowerPoint.Application")
Set ppFile = pptApp.ActivePresentation
Set wks = ThisWorkbook.ActiveSheet
zeile = 1
For Each ppSlide In ppFile.Slides
For Each ppShape In ppSlide.Shapes
If ppShape.Type = msoChart Then
Set ppChart = ppShape.Chart
Set ppChartData = ppChart.ChartData
ppChartData.Activate
Set ppdatawkb = ppChartData.Workbook
ppdatawkb.Sheets(1).UsedRange.Copy
wks.Cells(zeile, 4).PasteSpecial xlValues
ppdatawkb.Close
zeile = zeile + 20
Set ppdatawkb = Nothing
End If
Next ppShape
Next ppSlide
Set pptApp = Nothing
Set ppFile = Nothing
Set ppSlide = Nothing
Set ppShape = Nothing
Set ppChart = Nothing
Set ppChartData = Nothing
End Sub
|