Consulting

Results 1 to 14 of 14

Thread: VBA to take image file path text in bookmark and insert image at bookmark

  1. #1
    VBAX Regular
    Joined
    May 2018
    Posts
    10
    Location

    VBA to take image file path text in bookmark and insert image at bookmark

    Hi all,

    I have a word document that is bookmarked so that the each bookmark is filled with the contents of a cell from an excel sheet. For example bookmark 'logo1' will draw from D5, 'logo2' from D6 and so on. Thee bookmarks are filled with vba in excel.

    Each of the cells being referenced contain the file path of a .png image. So, when the bookmark is filled it contains text such as s:\picture1.png or s:\otherexample.png. Instead , I would like to create a vba in word so that the text of 's:\picture1.png' that is iflling a bookmark is to be cut and replaced with the image that the file path leads to. Basically to have no text at the bookmark, but to have an image instead - and to do this for each of the ten bookmarks.

    I have ten bookmarks - labelled logo1 to logo10. Unfortunately the 10 cells in the excel sheet are dynamic based on other selection made in the workbook - so I can't just say cell x = image file path 'y'.

    Any help appreciated!! Thanks

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cross-posted at: https://www.excelforum.com/excel-pro...ml#post4896620

    Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3

    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    Perhaps something along the lines of the following
    Option Explicit
    
    Sub FillBookmarks()
    'Graham Mayor - http://www.gmayor.com - Last updated - 12 May 2018
    Dim oBM As Bookmark
    Dim strPath As String
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        For Each oBM In ActiveDocument.Bookmarks
            strPath = Trim(oBM.Range.Text)
            If Right(LCase(strPath), 4) = ".png" Then
                If fso.FileExists(strPath) Then
                    ImageToBM oBM.Name, strPath
                End If
            End If
        Next oBM
    lbl_Exit:
        Set fso = Nothing
        Set oBM = Nothing
        Exit Sub
    End Sub
    
    Private Sub ImageToBM(strbmName As String, strImagePath As String)
    'Graham Mayor - http://www.gmayor.com
    Dim oRng As Range
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(strImagePath) Then
            With ActiveDocument
                On Error GoTo lbl_Exit
                Set oRng = .Bookmarks(strbmName).Range
                oRng.Text = ""
                oRng.InlineShapes.AddPicture _
                        FileName:=strImagePath, LinkToFile:=False, _
                        SaveWithDocument:=True
                oRng.End = oRng.End + 1
                oRng.Bookmarks.Add strbmName
            End With
        End If
    lbl_Exit:
        Set fso = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by JayRay View Post
    I have a word document that is bookmarked so that the each bookmark is filled with the contents of a cell from an excel sheet. For example bookmark 'logo1' will draw from D5, 'logo2' from D6 and so on. Thee bookmarks are filled with vba in excel.

    Each of the cells being referenced contain the file path of a .png image. So, when the bookmark is filled it contains text such as s:\picture1.png or s:\otherexample.png. Instead , I would like to create a vba in word so that the text of 's:\picture1.png' that is iflling a bookmark is to be cut and replaced with the image that the file path leads to.
    That's an incredibly round-about way of doing things. Since you already have the picture's path & name in Excel, why not simply use that to insert the image directly into the Word document at the bookmark instead?
    Last edited by macropod; 05-14-2018 at 01:56 AM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Regular
    Joined
    May 2018
    Posts
    10
    Location
    Thanks gmayor - I will give it a shot and let you know how it goes. Really appreciate the reply. Macropod - simply because I have no idea what I am doing!!! If you have a solution I'd love to hear it. I'm very new to this and flying by the seat of my pants. Not trying to be lazy, but just at the start of my learning.

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Well, without seeing your Excel code, it's impossible to say what (minor) changes it needs to make that a reality.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #7
    VBAX Regular
    Joined
    May 2018
    Posts
    10
    Location
    Hi, it is very basic stuff. Essentially I have a button that opens an existing template which has bookmarks that are then populated. Each of the bookmarks which have 'logo' in the name are being populated by the contents of column D (D5, D6, D7 etc) - with each of the column D cells housing the filepath of an image. Instead of the filepath being pasted into the bookmark I would like the image itself to be pasted in.

    Option Explicit
    Sub bookmark()
    Dim objWord As Object
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ActiveWorkbook
    Set ws = Sheets("Front page")
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    objWord.Documents.Open "S:\xxxxx\xxxx\xxxx\xxxx.docm"

    With objWord.ActiveDocument
    .Bookmarks("jobrole").Range.Text = ws.Range("B4").Value
    .Bookmarks("chat1").Range.Text = ws.Range("B5").Value
    .Bookmarks("logo1").Range.Text = ws.Range("D5").Value
    .Bookmarks("blurb1").Range.Text = ws.Range("E5").Value
    .Bookmarks("chat2").Range.Text = ws.Range("B6").Value
    .Bookmarks("logo2").Range.Text = ws.Range("D6").Value
    .Bookmarks("blurb2").Range.Text = ws.Range("E6").Value
    .Bookmarks("chat3").Range.Text = ws.Range("B7").Value
    .Bookmarks("logo3").Range.Text = ws.Range("D3").Value
    .Bookmarks("blurb3").Range.Text = ws.Range("E7").Value
    .Bookmarks("chat4").Range.Text = ws.Range("B8").Value
    .Bookmarks("logo4").Range.Text = ws.Range("D8").Value
    .Bookmarks("blurb4").Range.Text = ws.Range("E8").Value
    .Bookmarks("chat5").Range.Text = ws.Range("B9").Value
    .Bookmarks("logo5").Range.Text = ws.Range("D9").Value
    .Bookmarks("blurb5").Range.Text = ws.Range("E9").Value
    .Bookmarks("chat6").Range.Text = ws.Range("B10").Value
    .Bookmarks("logo6").Range.Text = ws.Range("D10").Value
    .Bookmarks("blurb6").Range.Text = ws.Range("E10").Value
    .Bookmarks("chat7").Range.Text = ws.Range("B11").Value
    .Bookmarks("logo7").Range.Text = ws.Range("D11").Value
    .Bookmarks("blurb7").Range.Text = ws.Range("E11").Value
    .Bookmarks("chat8").Range.Text = ws.Range("B12").Value
    .Bookmarks("logo8").Range.Text = ws.Range("D12").Value
    .Bookmarks("blurb8").Range.Text = ws.Range("E12").Value
    .Bookmarks("chat9").Range.Text = ws.Range("B13").Value
    .Bookmarks("logo9").Range.Text = ws.Range("D13").Value
    .Bookmarks("blurb9").Range.Text = ws.Range("E13").Value
    .Bookmarks("chat10").Range.Text = ws.Range("B14").Value
    .Bookmarks("logo10").Range.Text = ws.Range("D14").Value
    .Bookmarks("blurb10").Range.Text = ws.Range("E14").Value
    End With

    Set objWord = Nothing
    End Sub

    Thanks for any assistance.

  8. #8
    Paul is right in that the methodology is somewhat circuitous - though it works. You can adapt the function to allow it to work from Excel and insert the images in a single process e.g. as follows. I guess for a more robust system you would use error handling to establish that the bookmarks exist and that the files called exist, however ...

    Option Explicit
    
    Sub bookmark()
    Dim objWord As Object
    Dim wb As Workbook
    Dim ws As Worksheet
    
        Set wb = ActiveWorkbook
        Set ws = Sheets("Front page")
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        objWord.Documents.Open "S:\xxxxx\xxxx\xxxx\xxxx.docm"
    
        On Error Resume Next
        ImageToBM objWord.ActiveDocument, "jobrole", ws.Range("B4").value
        ImageToBM objWord.ActiveDocument, "chat1", ws.Range("B5").value
        ImageToBM objWord.ActiveDocument, "logo1", ws.Range("D5").value
        ImageToBM objWord.ActiveDocument, "blurb1", ws.Range("E5").value
        ImageToBM objWord.ActiveDocument, "chat2", ws.Range("B6").value
        ImageToBM objWord.ActiveDocument, "logo2", ws.Range("D6").value
        ImageToBM objWord.ActiveDocument, "blurb2", ws.Range("E6").value
        ImageToBM objWord.ActiveDocument, "chat3", ws.Range("B7").value
        ImageToBM objWord.ActiveDocument, "logo3", ws.Range("D3").value
        ImageToBM objWord.ActiveDocument, "blurb3", ws.Range("E7").value
        ImageToBM objWord.ActiveDocument, "chat4", ws.Range("B8").value
        ImageToBM objWord.ActiveDocument, "logo4", ws.Range("D8").value
        ImageToBM objWord.ActiveDocument, "blurb4", ws.Range("E8").value
        ImageToBM objWord.ActiveDocument, "chat5", ws.Range("B9").value
        ImageToBM objWord.ActiveDocument, "logo5", ws.Range("D9").value
        ImageToBM objWord.ActiveDocument, "blurb5", ws.Range("E9").value
        ImageToBM objWord.ActiveDocument, "chat6", ws.Range("B10").value
        ImageToBM objWord.ActiveDocument, "logo6", ws.Range("D10").value
        ImageToBM objWord.ActiveDocument, "blurb6", ws.Range("E10").value
        ImageToBM objWord.ActiveDocument, "chat7", ws.Range("B11").value
        ImageToBM objWord.ActiveDocument, "logo7", ws.Range("D11").value
        ImageToBM objWord.ActiveDocument, "blurb7", ws.Range("E11").value
        ImageToBM objWord.ActiveDocument, "chat8", ws.Range("B12").value
        ImageToBM objWord.ActiveDocument, "logo8", ws.Range("D12").value
        ImageToBM objWord.ActiveDocument, "blurb8", ws.Range("E12").value
        ImageToBM objWord.ActiveDocument, "chat9", ws.Range("B13").value
        ImageToBM objWord.ActiveDocument, "logo9", ws.Range("D13").value
        ImageToBM objWord.ActiveDocument, "blurb9", ws.Range("E13").value
        ImageToBM objWord.ActiveDocument, "chat10", ws.Range("B14").value
        ImageToBM objWord.ActiveDocument, "logo10", ws.Range("D14").value
        ImageToBM objWord.ActiveDocument, "blurb10", ws.Range("E14").value
    
        Set wb = Nothing
        Set ws = Nothing
        Set objWord = Nothing
    End Sub
    
    Private Sub ImageToBM(oDoc As Object, strbmName As String, strImagePath As String)
    'Graham Mayor - http://www.gmayor.com
    Dim oRng As Object
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(strImagePath) Then
            With oDoc
                On Error GoTo lbl_Exit
                Set oRng = oDoc.bookmarks(strbmName).Range
                oRng.Text = ""
                oRng.InlineShapes.AddPicture _
                        FileName:=strImagePath, LinkToFile:=False, _
                        SaveWithDocument:=True
                oRng.End = oRng.End + 1
                oRng.bookmarks.Add strbmName
            End With
        End If
    lbl_Exit:
        Set fso = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    I suspect not all the Excel values refer to images, rather only those with name's like 'logo' do. For such cases you could use code like:
    Dim i As Long, j As Long
    With ActiveDocument
      For i = 1 To 10
        Select Case i
          Case 3: j = i
          Case Else: j = i + 4
        End Select
        If Dir(ws.Range("D" & j).Value) <> "" Then
          .InlineShapes.AddPicture ws.Range("D" & j).Value,  ,  ,  .Bookmarks("logo" & i).Range
        End If
      Next
    End With
    The rest you can continue to populate as you're already doing, though I'm sure you can see from the above how a loop could be used to update those, too.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  10. #10
    VBAX Regular
    Joined
    May 2018
    Posts
    10
    Location
    Thanks to both of you for your time - very much appreciated!!! Macropod - I will use a loop solution for the 'blurb' and 'chat' bookmarks once I have dialed in the 'logo' appearing. I am getting a 'type mismatch' error when running this code. I am getting the first two images logo1, logo2 filling as I wish, but getting blanks for logo 3 through to 10. I'm sorry if I'm missing something very basic - I can see how the loop works now, so am very comfortable there - but can't see a reason as to why there is an error for the third image. Any help greatly appreciated

    Option Explicit
    Sub bookmark()
    Dim objWord As Object
    Dim wb As Workbook
    Dim ws As Worksheet


    Set wb = ActiveWorkbook
    Set ws = Sheets("Front page")
    Set objWord = CreateObject("Word.Application")


    objWord.Visible = True
    objWord.Documents.Open "S:\xxxxxx.docm"


    With objWord.ActiveDocument
    .Bookmarks("jobrole").Range.Text = ws.Range("B4").Value
    .Bookmarks("chat1").Range.Text = ws.Range("B5").Value
    .Bookmarks("blurb1").Range.Text = ws.Range("E5").Value
    .Bookmarks("chat2").Range.Text = ws.Range("B6").Value
    .Bookmarks("blurb2").Range.Text = ws.Range("E6").Value
    .Bookmarks("chat3").Range.Text = ws.Range("B7").Value
    .Bookmarks("blurb3").Range.Text = ws.Range("E7").Value
    .Bookmarks("chat4").Range.Text = ws.Range("B8").Value
    .Bookmarks("blurb4").Range.Text = ws.Range("E8").Value
    .Bookmarks("chat5").Range.Text = ws.Range("B9").Value
    .Bookmarks("blurb5").Range.Text = ws.Range("E9").Value
    .Bookmarks("chat6").Range.Text = ws.Range("B10").Value
    .Bookmarks("blurb6").Range.Text = ws.Range("E10").Value
    .Bookmarks("chat7").Range.Text = ws.Range("B11").Value
    .Bookmarks("blurb7").Range.Text = ws.Range("E11").Value
    .Bookmarks("chat8").Range.Text = ws.Range("B12").Value
    .Bookmarks("blurb8").Range.Text = ws.Range("E12").Value
    .Bookmarks("chat9").Range.Text = ws.Range("B13").Value
    .Bookmarks("blurb9").Range.Text = ws.Range("E13").Value
    .Bookmarks("chat10").Range.Text = ws.Range("B14").Value
    .Bookmarks("blurb10").Range.Text = ws.Range("E14").Value


    Dim i As Long, j As Long
    For i = 1 To 10
    Select Case i
    Case 3: j = i
    Case Else: j = i + 4
    End Select
    If Dir(ws.Range("D" & j).Value) <> "" Then
    .InlineShapes.AddPicture ws.Range("D" & j).Value, , , .Bookmarks("logo" & i).Range
    End If
    Next

    End With


    End Sub

  11. #11
    VBAX Regular
    Joined
    May 2018
    Posts
    10
    Location
    Ah - I can see that I had a typo originally with D3 referenced to 'logo3' instead of D7 - hence the 'Case 3'. Have now got this and it appears to be working!! Thank you both so much for helping with my learning!

    Option Explicit
    Sub bookmark()
    Dim objWord As Object
    Dim wb As Workbook
    Dim ws As Worksheet


    Set wb = ActiveWorkbook
    Set ws = Sheets("Front page")
    Set objWord = CreateObject("Word.Application")


    objWord.Visible = True
    objWord.Documents.Open "S:\xxxx.docm"


    With objWord.ActiveDocument
    .Bookmarks("jobrole").Range.Text = ws.Range("B4").Value
    .Bookmarks("chat1").Range.Text = ws.Range("B5").Value
    .Bookmarks("blurb1").Range.Text = ws.Range("E5").Value
    .Bookmarks("chat2").Range.Text = ws.Range("B6").Value
    .Bookmarks("blurb2").Range.Text = ws.Range("E6").Value
    .Bookmarks("chat3").Range.Text = ws.Range("B7").Value
    .Bookmarks("blurb3").Range.Text = ws.Range("E7").Value
    .Bookmarks("chat4").Range.Text = ws.Range("B8").Value
    .Bookmarks("blurb4").Range.Text = ws.Range("E8").Value
    .Bookmarks("chat5").Range.Text = ws.Range("B9").Value
    .Bookmarks("blurb5").Range.Text = ws.Range("E9").Value
    .Bookmarks("chat6").Range.Text = ws.Range("B10").Value
    .Bookmarks("blurb6").Range.Text = ws.Range("E10").Value
    .Bookmarks("chat7").Range.Text = ws.Range("B11").Value
    .Bookmarks("blurb7").Range.Text = ws.Range("E11").Value
    .Bookmarks("chat8").Range.Text = ws.Range("B12").Value
    .Bookmarks("blurb8").Range.Text = ws.Range("E12").Value
    .Bookmarks("chat9").Range.Text = ws.Range("B13").Value
    .Bookmarks("blurb9").Range.Text = ws.Range("E13").Value
    .Bookmarks("chat10").Range.Text = ws.Range("B14").Value


    .Bookmarks("blurb10").Range.Text = ws.Range("E14").Value


    Dim i As Long, j As Long
    For i = 1 To 10
    Select Case i
    Case i: j = i + 4
    End Select
    If Dir(ws.Range("D" & j).Value) <> "" Then
    .InlineShapes.AddPicture ws.Range("D" & j).Value, , , .Bookmarks("logo" & i).Range
    End If
    Next

    End With


    End Sub

  12. #12
    The Case statement is unnecessary

    For i = 1 To 10
        j = i + 4
        If Dir(ws.Range("D" & j).value) <> "" Then
            .InlineShapes.AddPicture ws.Range("D" & j).value, , , .Bookmarks("logo" & i).Range
        End If
    Next i
    or
    For i = 1 To 10
        If Dir(ws.Range("D" & i + 4).value) <> "" Then
            .InlineShapes.AddPicture ws.Range("D" & i + 4).value, , , .Bookmarks("logo" & i).Range
        End If
    Next i
    would work
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  13. #13
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    And your overall code could be reduced to:
    Sub SendToBookmarks()
    Dim ws As Worksheet, objWord As Object, i As Long
    Set ws = ActiveWorkbook.Sheets("Front page")
    Set objWord = CreateObject("Word.Application")
    With objWord
      .Visible = True
      .Documents.Open "S:\xxxxxx.docm", , False, False
      With .ActiveDocument
        .Bookmarks("jobrole").Range.Text = ws.Range("B4").Value
        For i = 1 To 10
          If Dir(ws.Range("D" & i + 4).Value) <> "" Then
            .InlineShapes.AddPicture ws.Range("D" & i + 4).Value, , , .Bookmarks("logo" & i).Range
          End If
          .Bookmarks("chat" & i).Range.Text = ws.Range("B" & i + 4).Value
          .Bookmarks("blurb" & i).Range.Text = ws.Range("E" & i + 4).Value
        Next
      End With
    End With
    End Sub
    PS: When posting code, please structure your code and use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  14. #14
    VBAX Regular
    Joined
    May 2018
    Posts
    10
    Location
    Thanks macropod - greatly appreciated

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •