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