Extract Data from Excel Graph located in PowerPoint 2010 using VBA?

Hi
I'm sure one of the VBA experts could do a better job than this, but at least it sort of does the trick

Run the macro in Powerpoint. It will copy the x values and series names and values into the clipboard in a single long column that you can then paste into Excel. I haven't worked out how to arrange the series data in adjacent columns in the clipboard, though I'm sure this can be done.

Make sure microsoft forms 2.0 is checked in tools > references, or the dataobject code won't work

Sub copy_series_values_to_clipboard()
Dim ss As Variant, n As Long, txt As String, se, sh As Shape
Dim mydata As DataObject
Set mydata = New DataObject

txt = "X Values" & Chr(13)

chartshape = ""
For Each sh In ActiveWindow.Selection.SlideRange.Shapes
    If sh.Type = 3 Then chartshape = sh.Name
Next sh

ss = ActiveWindow.Selection.SlideRange.Shapes(chartshape).Chart.SeriesCollection(1).XValues
For n = 1 To ActiveWindow.Selection.SlideRange.Shapes(chartshape).Chart.SeriesCollection(1).Points.Count
    txt = txt & ss(n) & Chr(13)
Next n

For Each se In ActiveWindow.Selection.SlideRange.Shapes(chartshape).Chart.SeriesCollection
    txt = txt & Chr(13) & se.Name & Chr(13)
    ss = se.Values
    For n = 1 To se.Points.Count
        txt = txt & ss(n) & Chr(13)
    Next n
Next se

mydata.SetText txt
mydata.PutInClipboard

MsgBox "Copied to clipboard:" & Chr(13) & txt
mydata.Clear

End Sub

how will you identify the chart you want - do you know its name or number?

Originally Posted by NickyC

how will you identify the chart you want - do you know its name or number?

If I press ALT+F10, it brings up the Selection and Visibility pane which allows me to see the naming of all the various charts. When I click on the chart I want, it highlights the Chart name/number.

Hi
calling the selections and returning the value to the macro is beyond my VBA skills I'm afraid.

But this modification of the macro above achieves a similar result - listing all the chart shapes on the slide, allowing the user to select one then extracting the values from it.

Sub copy_series_values_to_clipboard()
Dim ss As Variant, n As Long, txt As String, se, sh As Shape, ChartList As String, res
Dim mydata As DataObject
Set mydata = New DataObject

txt = "X Values" & Chr(13)
ChartList = ""
res = ""

For Each sh In ActiveWindow.Selection.SlideRange.Shapes
    If sh.Type = 3 Then
        ChartList = ChartList & Chr(13) & sh.Id & "  " & sh.Name
        If res = "" Then res = sh.Name
    End If
  Next sh

If ChartList = "" Then
    MsgBox "no chart found"
    End
End If

res = InputBox("enter the name of the shape to extract data from" & Chr(13) & Chr(13) & ChartList, "enter number", res)

chartshape = res

ss = ActiveWindow.Selection.SlideRange.Shapes(chartshape).Chart.SeriesCollection(1).XValues
For n = 1 To ActiveWindow.Selection.SlideRange.Shapes(chartshape).Chart.SeriesCollection(1).Points.Count
    txt = txt & ss(n) & Chr(13)
Next n

For Each se In ActiveWindow.Selection.SlideRange.Shapes(chartshape).Chart.SeriesCollection
    txt = txt & Chr(13) & se.Name & Chr(13)
    ss = se.Values
    For n = 1 To se.Points.Count
        txt = txt & ss(n) & Chr(13)
    Next n
Next se

mydata.SetText txt
mydata.PutInClipboard

MsgBox "Copied to clipboard:" & Chr(13) & txt
mydata.Clear

End Sub

Perfect! This worked great! This will be a good solution for future instances of this I come across. Thanks so much for your help!

Just a recap for anyone else that comes across this thread.
1. If you cant find Microsoft Forms 2.0 in the object Tools Reference Library, search for FM20.dll
2. Use Alt-F10 to find chart number of chart you're looking for
3. If an axis has a date range in the chart, it will show as numerical value. Just format it as a date in Excel after pasting over.

Trying to use this but the charts I have are appearing as "Content Placeholder n" where n is a number?

bump bump bump

Hi
I'm no PowerPoint expert, so may not be much use to you. My understanding is that the content placeholder is not a chart, it's a shape on the slide into which you can put charts etc. The macro will only work on a chart created in excel and copied as an excel chart into PowerPoint. if it's in another format (e.g. picture), the macro won't work.

when I run the marco it tells me to select a range?

I'm a bit confused.

Hi

if anyone is looking for a macro that copies data values from a chart in PowerPoint back into Excel, this works for me

it copies data in columns, with x-axis data in the first column, first series data in the second etc. Set the first cell to copy into as DestCell

Sub chart_export_values_to_excel()
'copies values from the last chart on the slide into the active excel spreadsheet starting at cell set as DestCell
'Microsoft excel object library must be checked in tools > references for this to work

Dim MyMsExcel As Object
Dim ExcelWasNotRunning As Boolean
Dim ChartShape As String
Dim sh As Shape, ss As Variant
Dim GFile As Excel.Workbook
Dim DestCell As Excel.Range
Dim XOff As Long, Yoff As Long

Set MyMsExcel = GetObject(, "excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear   ' Clear Err object in case error occurred.
If ExcelWasNotRunning = True Then MsgBox "excel is not running" 'Else MsgBox "excel is running"

If ExcelWasNotRunning = False Then
    
    Set GFile = GetObject(MyMsExcel.Activeworkbook.FullName)
    
    '******** destination cell for data:
    Set DestCell = GFile.Sheets(1).Cells(1, 1)
    ChartShape = ""
    For Each sh In ActiveWindow.Selection.SlideRange.Shapes
        If sh.Type = 3 Then ChartShape = sh.Name
    Next sh

    XOff = 0
    Yoff = 0
    ss = ActiveWindow.Selection.SlideRange.Shapes(ChartShape).Chart.SeriesCollection(1).XValues
    For n = 1 To ActiveWindow.Selection.SlideRange.Shapes(ChartShape).Chart.SeriesCollection(1).Points.Count
        DestCell.Offset(XOff + 1, Yoff) = ss(n)
        XOff = 1 + XOff
    Next n

    For Each se In ActiveWindow.Selection.SlideRange.Shapes(ChartShape).Chart.SeriesCollection
        XOff = 0
        Yoff = 1 + Yoff
        ss = se.Values
        DestCell.Offset(XOff, Yoff) = se.Name
        For n = 1 To se.Points.Count
            DestCell.Offset(XOff + 1, Yoff) = ss(n)
            XOff = XOff + 1
        Next n
    Next se

End If
Set MyMsExcel = Nothing
End Sub

when i use the last code it tells me : user-defined type not defined and blocks on Dim GFile As Excel.Workbook

any advice? can you help me on that Nick?

can't get it to work

and it works

thank you very much for taking the time to help me Jon Peltier

I greatly appreciate it