View Single Post
 
Old 10-05-2016, 05:43 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,137
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote