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

0 votes

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

Oct 30 in Others by Kithuzzz
• 20,660 points
44 views

1 answer to this question.

0 votes

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
answered Oct 30 by narikkadan
• 37,660 points

Related Questions In Others

0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9 in Others by gaurav
• 22,040 points
71 views
0 votes
1 answer

How do delete an specific page in a word document using Excel VBA?

Check the code below. I eliminated the ...READ MORE

answered Nov 21 in Others by narikkadan
• 37,660 points
29 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16 in Others by Edureka
• 13,640 points
210 views
0 votes
1 answer

How to print an Excel Sheet using VBA with Nitro PDF Creator in Excel 2016

you can use the built-in excel facilities ...READ MORE

answered Sep 24 in Others by narikkadan
• 37,660 points
131 views
0 votes
1 answer

Convert image (jpg, png, jpeg) to base64

Try this - it will perform the ...READ MORE

answered Sep 24 in Others by narikkadan
• 37,660 points
102 views
0 votes
1 answer

How can I find and replace text in Word using Excel VBA?

Try this code Option Explicit Const wdReplaceAll = 2 Sub ...READ MORE

answered Oct 15 in Others by narikkadan
• 37,660 points
115 views
0 votes
1 answer

Multiple find and replace in MS Word from a list in MS Excel

If I understand you correctly, you want ...READ MORE

answered Oct 28 in Others by narikkadan
• 37,660 points
46 views
0 votes
1 answer

Indent table pasted from Excel into Word

It is feasible to pick up the ...READ MORE

answered Oct 30 in Others by narikkadan
• 37,660 points
46 views
0 votes
1 answer
0 votes
1 answer

How to insert a picture into Excel at a specified cell position with VBA

Try this: With xlApp.ActiveSheet.Pictures.Insert(PicPath) With ...READ MORE

answered Oct 24 in Others by narikkadan
• 37,660 points
166 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP