Thread: [Solved] Updating tables in Word
View Single Post
 
Old 04-11-2025, 06:56 AM
BigMac'ro BigMac'ro is offline Windows 10 Office 2016
Novice
 
Join Date: Feb 2025
Posts: 9
BigMac'ro is on a distinguished road
Default Updating tables in Word

Hi,


for a report that has to get updates on a montly basis, I try to write a macro that would update all charts and tables in it automatically.
My approach is to bookmark every table and every chart and to export the list of bookmarks to Excel (macro for this works well). I then add, for each bookmark, the path to the file where the relevant table/chart is located, the corresponding worksheet as well as the chart name (or table range).
Let's only discuss the charts here. The macro I am currently working on would read this reference file, grab the charts in the right file and replace them at the bookmark location in word.
I am at a point where it works, here is the code:


Code:
Sub UpdateWordFromExcelMappings()
    Dim xlApp As Object
    Dim xlRefWB As Object
    Dim xlDataWB As Object
    Dim xlSheet As Object
    Dim chartObj As Object
    Dim chartImg As Object
    Dim i As Long, lastRow As Long
    Dim wordBookmark As String
    Dim filePath As String, sheetName As String, rangeOrChart As String
    Dim bmRange As Range

    ' Reference file and worksheet names
    Const REF_FILE_PATH As String = "\\Path\to\the\reference\file.xlsx"
    Const TABLE_SHEET As String = "Tables"
    Const CHART_SHEET As String = "Graphs"

    ' Start Excel
    Set xlApp = CreateObject("Excel.Application")
    Set xlRefWB = xlApp.Workbooks.Open(REF_FILE_PATH, False, True)


' === Handle Charts ===
    With xlRefWB.Sheets(CHART_SHEET)
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row  ' Find last used row in column A
        
        For i = 2 To lastRow
            ' Read and trim values from reference file
            wordBookmark = Trim(CStr(.Cells(i, 1).Text))
            filePath = Trim(CStr(.Cells(i, 5).Text))
            sheetName = Trim(CStr(.Cells(i, 6).Text))
            rangeOrChart = Trim(CStr(.Cells(i, 7).Text))
    
            ' Skip row if required info is missing
            If wordBookmark = "" Or filePath = "" Or sheetName = "" Or rangeOrChart = "" Then
                Debug.Print "Skipping chart row " & i & " due to missing data"
            Else
                ' Open chart source workbook (or reuse the reference file if same)
                If xlRefWB.FullName = filePath Then
                    Set xlDataWB = xlRefWB
                Else
                    If Not WorkbookIsOpen(filePath) Then
                        Set xlDataWB = xlApp.Workbooks.Open(filePath, False, True)
                    Else
                        Set xlDataWB = xlApp.Workbooks(filePath)
                    End If
                End If
    
                ' Try to get the worksheet
                Set xlSheet = xlDataWB.Sheets(sheetName)
    
                ' Try to get the chart object
                Set chartObj = Nothing
                On Error Resume Next
                Set chartObj = xlSheet.ChartObjects(rangeOrChart)
                On Error GoTo 0
    
                If Not chartObj Is Nothing Then
                    ' Copy the chart as an image
                    chartObj.CopyPicture Appearance:=1, Format:=2 ' xlScreen, xlPicture
    
                    ' Paste into Word if bookmark exists
                    If ActiveDocument.Bookmarks.Exists(wordBookmark) Then
                        Set bmRange = ActiveDocument.Bookmarks(wordBookmark).Range
                        bmRange.Paste
                        ActiveDocument.Bookmarks.Add wordBookmark, bmRange ' Re-add the bookmark after paste
                    End If
                Else
                    MsgBox "Chart '" & rangeOrChart & "' not found in sheet '" & sheetName & "'", vbExclamation
                End If
    
                ' Only close the workbook if it's not the reference file
                If Not xlDataWB Is xlRefWB Then xlDataWB.Close False
            End If
        Next i
    End With

    ' Cleanup
    xlRefWB.Close False
    xlApp.Quit
    Set xlApp = Nothing

    MsgBox "Tables and charts have been updated.", vbInformation
End Sub


Function WorkbookIsOpen(filePath As String) As Boolean
    Dim wb As Workbook
    On Error Resume Next ' In case of error (e.g., workbook not found)
    Set wb = xlApp.Workbooks(filePath) ' Try to get the workbook
    On Error GoTo 0 ' Reset error handling
    
    If Not wb Is Nothing Then
        WorkbookIsOpen = True ' Workbook is open
    Else
        WorkbookIsOpen = False ' Workbook is not open
    End If
End Function
The only thing bothering me is that the charts are copied as pictures, and I would like to have editable objects (but not necessarily linked to the source file). I tried to use
Code:
chartObj.Copy
instead of
Code:
chartObj.CopyPicture
but this throws runtime error 445.


Any idea how to solve this?


Thank you!


(code parts about tables removed here, that's another topic...)
Reply With Quote