Hi,
I'm trying to use VBA to extract underlying data from charts in powerpoint to excel, i.e from the underlying powerpoint datasheet that feeds the chart.
I've found the macro below on the net. It copies the data in each chart/datasheet and slide in powerpoint but I'm struggling with the bit to get the data into excel.
Below it I've tried incoporating some code to paste into excel but it does not seem to work.
Hope someone can help.
Thanks,
Lucas
I'm trying to use VBA to extract underlying data from charts in powerpoint to excel, i.e from the underlying powerpoint datasheet that feeds the chart.
I've found the macro below on the net. It copies the data in each chart/datasheet and slide in powerpoint but I'm struggling with the bit to get the data into excel.
Below it I've tried incoporating some code to paste into excel but it does not seem to work.
Hope someone can help.
Thanks,
Lucas
Code:
Sub GetChartData1() 'copies data from sheet Dim s As Shape 'gr As Graph.Chart Dim gr As Object Dim sl As Slide 'Copies data from datasheet in powerpoint For Each sl In ActivePresentation.Slides For Each s In sl.Shapes If s.Type = msoEmbeddedOLEObject Then 'we have found an OLE object 'check if it's a graph If s.OLEFormat.ProgID = "MSGraph.Chart.8" Then 'this might vary depending on what version you're using 'now get a handle on the graph object itself Set gr = s.OLEFormat.Object gr.Application.DataSheet.Cells.Copy End If End If Next s Next sl End Sub Sub GetChartData2() ' includes code to paste into excel Dim s As Shape 'gr As Graph.Chart Dim gr As Object Dim sl As Slide 'Copies data from datasheet in powerpoint For Each sl In ActivePresentation.Slides For Each s In sl.Shapes If s.Type = msoEmbeddedOLEObject Then 'we have found an OLE object 'check if it's a graph If s.OLEFormat.ProgID = "MSGraph.Chart.8" Then 'this might vary depending on what version you're using 'now get a handle on the graph object itself Set gr = s.OLEFormat.Object gr.Application.DataSheet.Cells.Copy 'Paste into excel - this section not working Workbooks("test.xls").Sheets("sheet1").Activate Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If End If Next s Next sl End Sub
Comment