Generate a Histogram of a Word Table

Question

I am working on a VBA macro in Microsoft Word that is supposed to generate a histogram ( Clustered Column ) from data in a table within the document Word.

I have written the following code to accomplish this task:

Sub GenerateHistogram()
    Dim tbl As Table
    Dim rngData As Range
    Dim chartObj As Object

    ' Select the table containing the data
    Set tbl = ActiveDocument.Tables(1)

    ' Define the data range from the table
    Set rngData = tbl.Range

    ' Insert a chart into the document
    Set chartObj = ActiveDocument.Shapes.AddChart2(201, xlColumnClustered).Chart

    ' Add the data to the chart
    ' problem happens here
    chartObj.SetSourceData Source:=rngData, PlotBy:=xlColumns

    ' Adjust the size of the chart
    chartObj.Parent.Width = 400
    chartObj.Parent.Height = 300
End Sub

However, when I run this macro, I receive an "Automation Error, Unspecified Error" :

I have checked that macros are enabled in Word and that my table is correctly formatted. I am not sure what is causing this error and how to fix it. Can someone help me understand what's wrong with my code and how to correct it?

Any help would be greatly appreciated. Thanks in advance!

Answer 1

• The chart in the Word document is actually based on data from an Excel table that is embedded in the Word document.

• Add references Microsoft Excel x.0 Object Library before running the code. (VBE menu Tools > References)

Sub CreateWordChart()
    Dim oChart As Chart, oTable As Table
    Dim oSheet As Excel.Worksheet
    Dim RowCnt As Long, ColCnt As Long
    Application.ScreenUpdating = False
    ' get the first table in Doc
    Set oTable = ActiveDocument.Tables(1)  ' modify as needed
    Set oChart = ActiveDocument.Shapes.AddChart.Chart
    Set oSheet = oChart.ChartData.Workbook.Worksheets(1)
    ' get the size of Word table
    RowCnt = oTable.Rows.Count
    ColCnt = oTable.Columns.Count
    With oSheet.ListObjects("Table1")
        ' remove content
        .DataBodyRange.Delete
        ' resize Table1
        .Resize oSheet.Range("A1").Resize(RowCnt, ColCnt)
        ' copy Word table to Excel table
        oTable.Range.Copy
        .Range.Select
        .Parent.Paste
    End With
    oChart.PlotBy = xlRows
    oChart.ChartData.Workbook.Close
    Application.ScreenUpdating = True
End Sub