![]() |
#1
|
|||
|
|||
![]() 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 Code:
chartObj.Copy Code:
chartObj.CopyPicture Any idea how to solve this? Thank you! (code parts about tables removed here, that's another topic...) |
Tags |
charts, copy, update |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
soroush.kalantari | Word VBA | 3 | 06-27-2021 06:15 PM |
Problem With Updating Linked Excel Tables in Word 2013 | maverick1714 | Word | 6 | 09-30-2014 12:30 AM |
![]() |
awaywithpixie | Word | 1 | 09-10-2013 10:35 AM |
Updating lists of figures/Tables in a protected document | IHARKIS | Word | 0 | 03-02-2011 04:39 AM |
Auto-updating basic math functions & cross-referencing tables | FranklinBluth | Word Tables | 13 | 11-19-2009 10:26 AM |