Microsoft Office Forums - View Single Post - [Solved] Change Logo in Header in many Word-Documents

gmayor · 10-13-2016, 09:20 PM

The following macro will do the job, subject to some provisos. The main one is that your example is an accurate reflection of the documents in question. It looks for headers that have one image that is not inserted in-line - and when it finds one it deletes that image and places another in the header at the location specified. There can be many headers in a document! If you want it to address only one header you will have to change the code to reflect that.

The macro is intended to be run from

http://www.gmayor.com/document_batch_processes.htm, which will perform the folder/file handling tasks, as a Custom Process

Code:

Option Explicit

Function ChangeLogo(oDoc As Document) As Boolean
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oShape As Shape
'change the path as appropriate
Const strImage As String = "C:\Path\Documents\BEM Logo definitiv Höhe 1.75cm Farben kräftiger.jpg"
On Error GoTo err_handler
        For Each oSection In oDoc.Sections
        For Each oHeader In oSection.Headers
            If oHeader.Exists Then
                If oHeader.Range.ShapeRange.Count = 1 Then
                    oHeader.Range.ShapeRange(1).Delete
                    Set oShape = oHeader.Shapes.AddPicture(FileName:=strImage)
                    With oShape
                        .RelativeHorizontalPosition = _
                        wdRelativeHorizontalPositionColumn
                        .RelativeVerticalPosition = _
                        wdRelativeVerticalPositionParagraph
                        .Left = CentimetersToPoints(13.75)
                        .Top = CentimetersToPoints(-0.7)
                    End With
                    ChangeLogo = True
                End If
            End If
        Next oHeader
    Next oSection
lbl_Exit:
    Set oSection = Nothing
    Set oHeader = Nothing
    Set oShape = Nothing
    Exit Function
err_handler:
    ChangeLogo = False
    Resume lbl_Exit
End Function