When the source and target documents are differently formatted with respect to margins, working out where to position the images can be something of a trial, but given the examples the following should be close:
Code:
Option Explicit
Private Sub CommandButton3_Click()
Dim MyDialog As FileDialog, GetStr(1 To 100) As String
Dim Doc As Document
Dim stiSelectedItem As Variant
Dim i As Integer, j As Integer
On Error Resume Next
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.docx", 1
.AllowMultiSelect = True
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
Application.ScreenUpdating = False
For j = 1 To i Step 1
Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
ReplaceHeaderFooter Doc
Doc.Save
Doc.Close
Next
Application.ScreenUpdating = True
End With
lbl_Exit:
Set MyDialog = Nothing
Set Doc = Nothing
Exit Sub
End Sub
Sub ReplaceHeaderFooter(ByVal oDoc As Document)
Dim oSec As Section
Dim oHead As HeaderFooter
Dim oFoot As HeaderFooter
Dim oRng As Range
Dim oShape As InlineShape
For Each oSec In oDoc.Sections
For Each oHead In oSec.Headers
If oHead.Exists Then
Set oRng = oHead.Range
With oRng
.ParagraphFormat.RightIndent = InchesToPoints(0.4)
.Text = Chr(13)
.Collapse 0
.ParagraphFormat.Alignment = wdAlignParagraphRight
Set oShape = .InlineShapes.AddPicture(FileName:="https://intranet.ggh.uk/elements/20161003_Ensure_insurance_certificate_header.png")
oShape.Width = InchesToPoints(1.42)
oShape.Height = InchesToPoints(1.07)
End With
End If
Next oHead
For Each oFoot In oSec.Footers
If oFoot.Exists Then
Set oRng = oFoot.Range
With oRng
.ParagraphFormat.LeftIndent = InchesToPoints(-0.9)
.Text = ""
.ParagraphFormat.Alignment = wdAlignParagraphLeft
Set oShape = .InlineShapes.AddPicture(FileName:="https://intranet.ggh.uk/elements/20161003_Ensure_insurance_certificate_footer.png")
oShape.Width = InchesToPoints(8.27)
oShape.Height = InchesToPoints(1.88)
End With
End If
Next oFoot
Next oSec
lbl_Exit:
Set oSec = Nothing
Set oHead = Nothing
Set oFoot = Nothing
Set oShape = Nothing
Set oRng = Nothing
Exit Sub
End Sub