PDA

View Full Version : VBA Macro to copy multiple charts from one excel file to a word bookmark locations



megant
08-09-2017, 11:18 PM
Hello,

I am new to using VBA but have found it very helpful with autofilling bookmarks in word from data contained in excel.

I managed to use the following code to successfully input cell data into a report in word:


Sub test()
Dim objWord As Object
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Class Teacher Responses")

Set objWord = CreateObject("Word.Application")

objWord.Visible = True

objWord.Documents.Open "G:\REPORT\TEST_FILE.docx"

With objWord.ActiveDocument
.Bookmarks("TR_1").Range.Text = ws.Range("B2").Value
.Bookmarks("TR_2").Range.Text = ws.Range("C2").Value
.Bookmarks("TR_3").Range.Text = ws.Range("D2").Value
.Bookmarks("TR_4").Range.Text = ws.Range("E2").Value
.Bookmarks("TR_5").Range.Text = ws.Range("F2").Value
.Bookmarks("TR_6").Range.Text = ws.Range("G2").Value
.Bookmarks("TR_7").Range.Text = ws.Range("H2").Value
.Bookmarks("TR_8").Range.Text = ws.Range("I2").Value
.Bookmarks("TR_9").Range.Text = ws.Range("J2").Value
.Bookmarks("TR_10").Range.Text = ws.Range("K2").Value
.Bookmarks("TR_11").Range.Text = ws.Range("L2").Value
.Bookmarks("TR_12").Range.Text = ws.Range("M2").Value
.Bookmarks("TR_13").Range.Text = ws.Range("N2").Value
.Bookmarks("TR_14").Range.Text = ws.Range("O2").Value
.Bookmarks("TR_15").Range.Text = ws.Range("P2").Value
.Bookmarks("TR_16").Range.Text = ws.Range("Q2").Value
.Bookmarks("TR_17").Range.Text = ws.Range("R2").Value
.Bookmarks("TR_18").Range.Text = ws.Range("S2").Value
.Bookmarks("TR_19").Range.Text = ws.Range("T2").Value
.Bookmarks("TR_20").Range.Text = ws.Range("U2").Value
.Bookmarks("TR_21").Range.Text = ws.Range("V2").Value
.Bookmarks("TR_22").Range.Text = ws.Range("W2").Value
.Bookmarks("TR_23").Range.Text = ws.Range("X2").Value
.Bookmarks("TR_24").Range.Text = ws.Range("Y2").Value
.Bookmarks("TR_25").Range.Text = ws.Range("Z2").Value
.Bookmarks("TR_26").Range.Text = ws.Range("AA2").Value
.Bookmarks("TR_27").Range.Text = ws.Range("AB2").Value
.Bookmarks("TR_28").Range.Text = ws.Range("AC2").Value
End With

Set objWord = Nothing

End Sub







Now, I need to do essentially the same thing but with charts.

I have a master excel file with multiple charts across three excel sheets.

I need to be able to copy the charts (about 50 in all) into the word document at the bookmarked locations to prepare a series of reports.

I have tried other codes off this site and the web, but have been unable to get the syntax right.

If anyone is able to point me in the right direction, I'd be very grateful. I have asked around in the office but unfortunately nobody has the answer.

gmayor
08-10-2017, 01:31 AM
I wouldn't do it quite like that, but the following should help, as it writes the values to the bookmarks and retains the bookmarks. If the bookmark is missing the macro doesn't crash.

For the charts you need to identify the appropriate chart - here the first chart on the sheet 'Chart' and copy and paste the chart to the named bookmark e.g. as follows

You may find http://www.gmayor.com/mail_merge_charts.htm and/or http://www.gmayor.com/mail_merge_charts_2.html useful.


Option Explicit
'Graham Mayor - http://www.gmayor.com - Last updated - 10 Aug 2017
Sub test()
Dim objWord As Object
Dim objDoc As Object
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Class Teacher Responses")

On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err Then
Set objWord = CreateObject("Word.Application")
End If
On Error GoTo 0
objWord.Visible = True

Set objDoc = objWord.Documents.Open("G:\REPORT\TEST_FILE.docx")

FillBM "TR_1", ws.Range("B2").value, objDoc
FillBM "TR_2", ws.Range("C2").value, objDoc
FillBM "TR_3", ws.Range("D2").value, objDoc
FillBM "TR_4", ws.Range("E2").value, objDoc
FillBM "TR_5", ws.Range("F2").value, objDoc
FillBM "TR_6", ws.Range("G2").value, objDoc
FillBM "TR_7", ws.Range("H2").value, objDoc
FillBM "TR_8", ws.Range("I2").value, objDoc
FillBM "TR_9", ws.Range("J2").value, objDoc
FillBM "TR_10", ws.Range("K2").value, objDoc
FillBM "TR_11", ws.Range("L2").value, objDoc
FillBM "TR_12", ws.Range("M2").value, objDoc
FillBM "TR_13", ws.Range("N2").value, objDoc
FillBM "TR_14", ws.Range("O2").value, objDoc
FillBM "TR_15", ws.Range("P2").value, objDoc
FillBM "TR_16", ws.Range("Q2").value, objDoc
FillBM "TR_17", ws.Range("R2").value, objDoc
FillBM "TR_18", ws.Range("S2").value, objDoc
FillBM "TR_19", ws.Range("T2").value, objDoc
FillBM "TR_20", ws.Range("U2").value, objDoc
FillBM "TR_21", ws.Range("V2").value, objDoc
FillBM "TR_22", ws.Range("W2").value, objDoc
FillBM "TR_23", ws.Range("X2").value, objDoc
FillBM "TR_24", ws.Range("Y2").value, objDoc
FillBM "TR_25", ws.Range("Z2").value, objDoc
FillBM "TR_26", ws.Range("AA2").value, objDoc
FillBM "TR_27", ws.Range("AB2").value, objDoc
FillBM "TR_28", ws.Range("AC2").value, objDoc

'Charts
Set ws = ThisWorkbook.Sheets("Chart")
ws.ChartObjects(1).Copy
ChartBM "CH_1", objDoc

'Repeat for each chart


Set objWord = Nothing
Set objDoc = Nothing

End Sub

Private Sub FillBM(strBMName As String, strValue As String, oDoc As Object)
'Graham Mayor - http://www.gmayor.com - Last updated - 10 Aug 2017
Dim oRng As Object
With oDoc
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
oRng.Text = strValue
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

Private Sub ChartBM(strBMName As String, oDoc As Object)
'Graham Mayor - http://www.gmayor.com - Last updated - 10 Aug 2017
Dim oRng As Object
With oDoc
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
oRng.Text = ""
oRng.Paste
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

snb
08-10-2017, 03:30 AM
or

Sub M_snb()
sn=ThisWorkbook.Sheets("Class Teacher Responses").range("B2:AC2")

with getobject("G:\REPORT\TEST_FILE.docx")
for j=1 to 28
.Bookmarks("TR_" & j).Range.Text = sn(1,j)
next
End With
End Sub

I'd prefer to use DocVariables to store Excel values.