Trying to create an enclosing bookmark after pasting a picture from Excel into Word using VBA

Question

I've spent a lot of time searching online, including on this topic and a number of others, but I can't seem to discover the solution, which I had assumed would be much simpler than it is now.
I'm creating code to automate a report, most of which is data that we have in excel. My code is really straightforward: Take the text in those few cells, those graphs, those tables, copy them all, and paste them all into designated bookmarks (as images for graphs and tables). This process is going perfectly thus far. I've tried several different approaches to scripting it, primarily using loops, but using bookmarks has proven to be really difficult and not very flexible, so the code is just a pretty straightforward repetition of steps. I'm just getting started with creating inter-office word macros. Until I need to rerun my code, it accomplishes precisely what was indicated before. The intention is for the macro to run once again and replace any texts, photos, or tables that were initially pasted.

Here's the code :

Sub IMPORT_TO_WORD()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim msWord As Object

'Set worksheets
Set ws1 = ThisWorkbook.Worksheets("Tableaux")
Set ws2 = ThisWorkbook.Worksheets("Graph")
Set ws3 = ThisWorkbook.Worksheets("REFERENCE MACRO")
Set ws4 = ThisWorkbook.Worksheets("Tableaux2")


     
    Filename = ws4.Range("B3")
       
   'Open word / check if it's open
    On Error Resume Next
    Set msWord = GetObject(class:="Word.Application")
    Err.Clear
    If msWord Is Nothing Then Set msWord = CreateObject(class:="Word.Application")
    
        
    With msWord
        .Visible = True
        .Documents.Open (Filename)
        .Activate
        Application.Wait Now + #12:00:03 AM#
        


'If ws4.Range("F1") = "English" Then
On Error GoTo 0

'Set the BookMarks range
    Set BMSALES = .ActiveDocument.Bookmarks(1).Range
    Set BMSALES2 = .ActiveDocument.Bookmarks(2).Range
    Set BMLISTINGS = .ActiveDocument.Bookmarks(3).Range
    Set BMLISTINGS2 = .ActiveDocument.Bookmarks(4).Range
    Set BMMEDPRICE = .ActiveDocument.Bookmarks(5).Range
    Set BMMEDPRICE2 = .ActiveDocument.Bookmarks(6).Range
    Set BMEVO = .ActiveDocument.Bookmarks(7).Range
    Set BMEVO2 = .ActiveDocument.Bookmarks(8).Range
    Set BMMKTCOND = .ActiveDocument.Bookmarks(9).Range
    Set BMGraph1 = .ActiveDocument.Bookmarks(10).Range
    Set BMGraph2 = .ActiveDocument.Bookmarks(11).Range
    Set BMGraph3 = .ActiveDocument.Bookmarks(12).Range
    Set BMGraph4 = .ActiveDocument.Bookmarks(13).Range
    Set BMGraph5 = .ActiveDocument.Bookmarks(14).Range
    Set BMTABLE1 = .ActiveDocument.Bookmarks(15).Range
    Set BMTABLE2 = .ActiveDocument.Bookmarks(16).Range
    Set BMTABLE3 = .ActiveDocument.Bookmarks(17).Range
    Set BMTABLE4 = .ActiveDocument.Bookmarks(18).Range
 
'Insert text
    BMSALES.Text = ws3.Range("B1")
    BMSALES2.Text = ws3.Range("B2")
    BMLISTINGS.Text = ws3.Range("B3")
    BMLISTINGS2.Text = ws3.Range("B4")
    BMMEDPRICE.Text = ws3.Range("B5")
    BMMEDPRICE2.Text = ws3.Range("B6")
    BMEVO.Text = ws3.Range("B7")
    BMEVO2.Text = ws3.Range("B8")
    BMMKTCOND.Text = ws3.Range("B9")

'Insert Graphs
            ws2.ChartObjects(5).Copy
            Application.Wait Now + #12:00:01 AM#
            BMGraph1.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
            
            ws2.ChartObjects(1).Copy
            Application.Wait Now + #12:00:01 AM#
            BMGraph5.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
            
            ws2.ChartObjects(2).Copy
            Application.Wait Now + #12:00:01 AM#
            BMGraph4.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
            
            ws2.ChartObjects(3).Copy
            Application.Wait Now + #12:00:01 AM#
            BMGraph3.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False

            ws2.ChartObjects(4).Copy
            Application.Wait Now + #12:00:01 AM#
            BMGraph2.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False

'Insert tables           
            ws1.Range("D3:P11").Copy
            Application.Wait Now + #12:00:01 AM#
            BMTABLE1.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
            
            ws1.Range("D22:P30").Copy
            Application.Wait Now + #12:00:01 AM#
            BMTABLE2.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, DisplayAsIcon:=False, Placement:=wdInLine
            
            ws1.Range("D41:P49").Copy
            Application.Wait Now + #12:00:01 AM#
            BMTABLE3.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, DisplayAsIcon:=False, Placement:=wdInLine
            
            ws1.Range("D60:P68").Copy
            Application.Wait Now + #12:00:01 AM#
            BMTABLE4.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, DisplayAsIcon:=False, Placement:=wdInLine
            
            Application.CutCopyMode = False
            
   'Put the bookmark back in the word doc to be able to use the macro again         
    ActiveDocument.Bookmarks.Add Name:="ASales", Range:=BMSALES
    ActiveDocument.Bookmarks.Add Name:="ASales2", Range:=BMSALES2
    ActiveDocument.Bookmarks.Add Name:="BLISTINGS", Range:=BMLISTINGS
    ActiveDocument.Bookmarks.Add Name:="BLISTINGS2", Range:=BMLISTINGS2
    ActiveDocument.Bookmarks.Add Name:="CMEDPRICE", Range:=BMMEDPRICE
    ActiveDocument.Bookmarks.Add Name:="CMEDPRICE2", Range:=BMMEDPRICE2
    ActiveDocument.Bookmarks.Add Name:="EVO1", Range:=BMEVO
    ActiveDocument.Bookmarks.Add Name:="EVO2", Range:=BMEVO2
    ActiveDocument.Bookmarks.Add Name:="FMKTCOND", Range:=BMMKTCOND
    ActiveDocument.Bookmarks.Add Name:="GRAPH1", Range:=BMGraph1
    ActiveDocument.Bookmarks.Add Name:="GRAPH2", Range:=BMGraph2
    ActiveDocument.Bookmarks.Add Name:="GRAPH3", Range:=BMGraph3
    ActiveDocument.Bookmarks.Add Name:="GRAPH4", Range:=BMGraph4
    ActiveDocument.Bookmarks.Add Name:="GRAPH5", Range:=BMGraph5
    ActiveDocument.Bookmarks.Add Name:="TABLE1", Range:=BMTABLE1
    ActiveDocument.Bookmarks.Add Name:="TABLE2", Range:=BMTABLE2
    ActiveDocument.Bookmarks.Add Name:="TABLE3", Range:=BMTABLE3
    ActiveDocument.Bookmarks.Add Name:="TABLE4", Range:=BMTABLE4
     
End With
End Sub

Since the constructed bookmark remains an enclosing bookmark, it works wonders for text. In order for the images to add up and not replace the bookmark when I use the macro again, the bookmark that is created becomes a placeholder bookmark and does not contain the photographs.

ActiveDocument.Bookmarks.Add Name:="GRAPH1", Range:=BMGraph1
BMGraph1.Select
ActiveDocument.Selection.Move Unit:=wdCharacter, Count:=1
ActiveDocument.Bookmarks.Add , Range:=Selection.Range

So that we select the newly placed placeholder, move the selection one character (I tried Selection.MoveRight as well) so that the image is selected and then reinsert the bookmark and ensure it's enclosed and then the macro could be run over and over.

But for some reason, I get an "object doesn't support this property or method VBA" error at the Selection. Move which I have trouble understanding since it definitely a supported method for Selection.

I've tried numerous approaches but haven't been successful. I think I was the closest with this:

    ActiveDocument.Bookmarks.Add Name:="TABLE3", Range:=BMTABLE3
    ActiveDocument.Bookmarks.Add Name:="TABLE4", Range:=BMTABLE4
     
End With
End Sub

narikkadan · Answer 1 · Oct 30, 2022

Try this:

Sub IMPORT_TO_WORD()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim ObjWd As Object, ObjDoc As Object
Dim r As Long, ArrTxtBkMk(), ArrImgBkMk(), ArrImgSrc(), ArrTblBkMk(), ArrTblSrc()
'Set worksheets
With ThisWorkbook
  Set ws1 = .Worksheets("Tableaux")
  Set ws2 = .Worksheets("Graph")
  Set ws3 = .Worksheets("REFERENCE MACRO")
  Set ws4 = .Worksheets("Tableaux2")
End With
       
'Open word / check if it's open
On Error Resume Next
Set ObjWd = GetObject(class:="Word.Application")
Err.Clear
If ObjWd Is Nothing Then
  Set ObjWd = CreateObject(class:="Word.Application")
End If
On Error GoTo 0
ArrTxtBkMk = Array(, "ASales", "ASales2", "BLISTINGS", "BLISTINGS2", _
            "CMEDPRICE", "CMEDPRICE2", "EVO1", "EVO2", "FMKTCOND")
ArrImgBkMk = Array("GRAPH1", "GRAPH2", "GRAPH3", "GRAPH4", "GRAPH5")
ArrImgSrc = Array(5, 1, 2, 3, 4)
ArrTblBkMk = Array("TABLE1", "TABLE2", "TABLE3", "TABLE4")
ArrTblSrc = Array("D3:P11", "D22:P30", "D41:P49", "D60:P68")

With ObjWd
  .Visible = True
  Set ObjDoc = .Documents.Open(ws4.Range("B3"))
  'Update Text bookmark ranges
  For r = 1 To UBound(ArrTxtBkMk)
    Call UpdateTextBookmark(ObjDoc, "" & ArrTxtBkMk(r) & "", ws3.Range("B" & r))
  Next
  'Update Image bookmark ranges
  For r = 0 To UBound(ArrImgBkMk)
    ws2.ChartObjects(ArrImgSrc(r)).Copy
    Call UpdateImageBookmark(ObjDoc, "" & ArrImgBkMk(r) & "")
  Next
  'Update table bookmark ranges
  For r = 0 To UBound(ArrTblBkMk)
    ws1.Range("" & ArrTblSrc(r) & "").Copy
    Call UpdateImageBookmark(ObjDoc, "" & ArrTblBkMk(r) & "")
  Next
End With
Application.CutCopyMode = False
End Sub

Sub UpdateTextBookmark(ObjDoc As Object, StrBkMk As String, StrTxt As String)
Dim ObjRng As Object
With ObjDoc
  If .Bookmarks.Exists(StrBkMk) Then
    Set ObjRng = .Bookmarks(StrBkMk).Range
    ObjRng.Text = StrTxt
    .Bookmarks.Add StrBkMk, ObjRng
  Else
    MsgBox StrBkMk & " bookmark NOT found!", vbExclamation
  End If
End With
Set ObjRng = Nothing
End Sub

Sub UpdateImageBookmark(ObjDoc As Object, StrBkMk As String)
Dim ObjRng As Object
With ObjDoc
  If .Bookmarks.Exists(StrBkMk) Then
    Set ObjRng = .Bookmarks(StrBkMk).Range
    With ObjRng
      .Range.Text = vbNullString
      .PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
        Placement:=wdInLine, DisplayAsIcon:=False
      .End = .End + 1
    End With
    .Bookmarks.Add StrBkMk, ObjRng
  Else
    MsgBox StrBkMk & " bookmark NOT found!", vbExclamation
  End If
End With
Set ObjRng = Nothing
End Sub