none
Extracting data from a graph in WORD RRS feed

  • Question

  • I have a graph with thousands of data points on Word that is no longer linked to the excel data/I no longer have the data for. I found a macro to extract data from a chart already in excel, but I can't move the chart to excel without it becoming just an empty graph with no data. Anyone have a macro that can be run IN WORD that will extract data? The data is clearly still in there as you can hover over the points and it shows the number, but I don't want to go back and type all the data this way if at all possible. Please help!
    Tuesday, September 17, 2019 5:33 AM

All replies

  • You can try this - you will need to use the VBA Editor's Tools->References menu option to add a reference to Microsoft Excel, and you will need to select the Chart. You should see the data in a new Workbook in Excel.

    Sub extractChartData()

    ' Adapted from Jon Peltier's macro at https://peltiertech.com/extract-chart-data/

    ' which starts with a chart that is already in Excel Dim i As Integer Dim j As Integer Dim srs As Series Dim xl As Excel.Application Dim wb As Excel.Workbook Dim ws As Excel.Worksheet Set xl = New Excel.Application xl.Visible = True Set wb = xl.Workbooks.Add Set ws = wb.Worksheets.Add If Selection.InlineShapes.Count = 1 Then With Selection.InlineShapes(1).Chart For i = 1 To .SeriesCollection.Count With .SeriesCollection(i) ws.Cells(1, 2 * i).Value = .Name ws.Cells(2, (2 * i) - 1).Resize(.Points.Count).Value = WorksheetFunction.Transpose(.XValues) ws.Cells(2, (2 * i)).Resize(.Points.Count).Value = WorksheetFunction.Transpose(.Values) End With Next End With Else With Selection.ShapeRange(1).Chart For i = 1 To .SeriesCollection.Count With .SeriesCollection(i) ws.Cells(1, 2 * i).Value = .Name ws.Cells(2, (2 * i) - 1).Resize(.Points.Count).Value = WorksheetFunction.Transpose(.XValues) ws.Cells(2, (2 * i)).Resize(.Points.Count).Value = WorksheetFunction.Transpose(.Values) End With Next End With End If
    Set ws = Nothing
    Set wb = Nothing
    Set xl = Nothing End Sub





    Peter Jamieson


    Tuesday, September 17, 2019 11:38 AM