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