Change Logo in Header in many Word-Documents

gmayor · #1 10-14-2016, 09:14 PM

It would make more sense to incorporate the footer changes into the function I posted, to give you the advantage of the error handling and reporting available in the Batch process. It seems that you have some document properties to change and associated fields in the footer, to which no reference was made in your earlier question. That being the case the following should do the job:

Code:

Function ChangeLogo(oDoc As Document) As Boolean
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oShape As Shape
Dim oStory As Range
Dim dp As DocumentProperties
    '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
    Set dp = ActiveDocument.BuiltInDocumentProperties
    dp("Title") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
    dp("Subject") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
    dp("Keywords") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
    dp("Category") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
    dp("Comments") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
    dp("Author") = "© CGLN-Team 2017,2018,2019,"
    dp("Company") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
    dp("Manager") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
    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
    For Each oStory In ActiveDocument.StoryRanges
        oStory.Fields.Update
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                oStory.Fields.Update
            Wend
        End If
    Next oStory
lbl_Exit:
    Set oSection = Nothing
    Set oHeader = Nothing
    Set oShape = Nothing
    Set oStory = Nothing
    Exit Function
err_handler:
    ChangeLogo = False
    Resume lbl_Exit
End Function

ika · #2 10-16-2016, 09:13 AM

Hi Gmayor

Once again, perfect work - thx very much.

As I wrote in my last two posts, I have a folder with many wordfiles ... I create the following code:

Quote:

Sub SetDocPropsPlusFooter()
'
' SetDocPropsPlusFooter Makro
'
Dim dd1 As Document
Dim dokupfad As String, endung As String, dateiname As String

dokupfad = "C:\Users\CGL-TEAM1\Desktop\Test Ordner\" '*path, where all the word files are
endung = "*.docx" '*doc-file
dateiname = Dir(dokupfad & endung)

'loop starts here

Do While dateiname <> ""
Set dd1 = Documents.Open(FileName:=dokupfad & dateiname) 'opens the document

ChangeLogo (????????????)

'save document
dd1.Save

'close document
dd1.Close
Set dd1 = Nothing

'next word file
dateiname = Dir 'next file

Loop

End Sub

How and where can I now start your function ChangeLogo? It needs a document ... but I'm not able to do it ... have you any advise for me?

Thx for your answer.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to Insert Logo in header on 1st page only and bookmark it.	youseeme	Word VBA	9	09-16-2016 05:25 AM
How to change logo /dates in numerous word documents without changing each one individually?	newi1	Word VBA	3	04-22-2016 07:02 PM
Can't change logo in Word 2007	jrasicmark	Word	5	04-12-2016 10:35 AM
How to print header logo only in 1st page	Shafraz Khahir	Word	1	11-29-2010 11:52 AM
Is there a way to change the header in a large amount of documents at one time?	ntsstaffing	Word	1	07-11-2009 12:12 PM