LucasLondon
12-02-2008, 05:01 AM
Hi,
I'm trying to use VBA to extract underlying data from charts in powerpoint, i.e from the underlying powerpoint (not excel) datasheet into excel.
I've found the macro below on the net. This copies the data in each chart and slide in powerpoint but I'm struggling with the bit to get the data into excel. The excel bit does not work at all, I hope someone can help.
Thanks,
Lucas
Sub GetChartData2() '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
'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
I'm trying to use VBA to extract underlying data from charts in powerpoint, i.e from the underlying powerpoint (not excel) datasheet into excel.
I've found the macro below on the net. This copies the data in each chart and slide in powerpoint but I'm struggling with the bit to get the data into excel. The excel bit does not work at all, I hope someone can help.
Thanks,
Lucas
Sub GetChartData2() '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
'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