VBA Insert Image(logo) into header for multiple Word Docs

Axis · #1 02-08-2022, 02:15 PM

I've modified an old macro from gmayor that I've found. However, while I know how to choose only the first page header in a sub, I'm not sure how to do it in a function.

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:\lh.png"
On Error GoTo err_handler
        For Each oSection In oDoc.Sections
        For Each oHeader In oSection.Headers
            Set oShape = oHeader.Shapes.AddPicture(FileName:=strImage)
                    With oShape
                        .RelativeHorizontalPosition = _
                        wdRelativeHorizontalPositionColumn
                        .RelativeVerticalPosition = _
                        wdRelativeVerticalPositionParagraph
                        .Left = CentimetersToPoints(-1)
                        .Top = CentimetersToPoints(-0.07)
                    End With
                    ChangeLogo = True
        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

My plan was to use Document Batch Processes to batch the process to run for all the word docs. However, the problem is I do not know how to set it for only the first page. Any help would be apprerciated!

Axis · #2 02-08-2022, 03:03 PM

Answer posted in case someone else runs into the issue....or I somehow forget and my own posts shows up in my google search 5 years from now. Thanks to GlowingEagle from the VBA reddit sub

Code:

Function ChangeLogo(oDoc As Document) As Boolean
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oShape As Shape
Const strImage As String = "C:\lh.png"
On Error GoTo Err_Handler
Set oSection = oDoc.Sections.First
' set first section header type - may conflict with other format desires...
oSection.PageSetup.DifferentFirstPageHeaderFooter = True
' seek first section again, otherwise logo is on wrong pages
Set oSection = oDoc.Sections.First
For Each oHeader In oSection.Headers
  If oHeader.IsHeader Then ' put logo on first header we find
    Set oShape = oHeader.Shapes.AddPicture(FileName:=strImage)
    With oShape
      .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
      .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
      .Left = CentimetersToPoints(-1)
      .Top = CentimetersToPoints(-0.07)
     End With
     ChangeLogo = True
     Exit For  ' done, exit
  End If
Next oHeader
lbl_Exit:
  Set oSection = Nothing
  Set oHeader = Nothing
  Set oShape = Nothing
  Exit Function
Err_Handler:
  ChangeLogo = False
  Resume lbl_Exit
End Function

gmayor · #3 02-08-2022, 10:17 PM

You don't need the loop

Code:

Function ChangeLogo(oDoc As Document) As Boolean
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oShape As Shape
Const strImage As String = "D:\My Documents\My Pictures\GMLogo.png"    '"C:\lh.png"
    On Error GoTo Err_Handler
    Set oSection = oDoc.Sections.First
    ' set first section header type - may conflict with other format desires...
    oSection.PageSetup.DifferentFirstPageHeaderFooter = True
    ' put logo on first page header
    Set oHeader = oSection.Headers(wdHeaderFooterFirstPage)
    Set oShape = oHeader.Shapes.AddPicture(FileName:=strImage)
    With oShape
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
        .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
        .Left = CentimetersToPoints(-1)
        .Top = CentimetersToPoints(-0.07)
    End With
    ChangeLogo = True
lbl_Exit:
    Set oSection = Nothing
    Set oHeader = Nothing
    Set oShape = Nothing
    Exit Function
Err_Handler:
    ChangeLogo = False
    Resume lbl_Exit
End Function

Axis · #4 02-09-2022, 08:06 AM

Awesome, I appreciate it...especially coming from you!

I did run into an issue where some of the smaller docs of 2 or 3 pages didn't have any sections at all, so I though to run a macro that goes through all of the documents and puts section breaks at the end of every page. It shouldn't do any harm if they already have section breaks should it? I will say when running this section break macro, I sometimes run into "object refers to a framed paragraph" error that kills the run and I have to manually edit that document.

Code:

Sub InsertBreaksIntoMultiDoc()
  Dim StrFolder As String
  Dim strFile As String
  Dim objDoc As Document
  Dim dlgFile As FileDialog
  Dim nTotalPageNumber As Integer
 
  Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker)
 
  With dlgFile
    If .Show = -1 Then
      StrFolder = .SelectedItems(1) & "\"
    Else
      MsgBox "No folder is selected! Please select the target folder."
      Exit Sub
    End If
  End With
 
  strFile = Dir(StrFolder & "*.docx", vbNormal)
 
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=StrFolder & strFile)
    For nTotalPageNumber = 1 To Selection.Information(wdNumberOfPagesInDocument)
      Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=nTotalPageNumber
      Application.Browser.Target = wdBrowsePage
      ActiveDocument.Bookmarks("\page").Range.Select
      Selection.Collapse wdCollapseEnd
      Selection.InsertBreak Type:=wdSectionBreakContinuous
    Next
    objDoc.Save
    objDoc.Close
    strFile = Dir()
  Wend
End Sub

gmayor · #5 02-09-2022, 10:34 PM

ALL documents have at least one section, so as the function I posted addresses the first section, for a document without section breaks, that will be the section addressed.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Change Header in multiple Docs	ambojoy	Word	1	07-03-2020 07:10 PM
insert multiple word docs into main word doc	MimiCush	Word	4	03-26-2018 01:07 PM
Change Logo in Header in many Word-Documents	ika	Word VBA	15	10-20-2016 11:08 PM
Macro to Insert Logo in header on 1st page only and bookmark it.	youseeme	Word VBA	9	09-16-2016 05:25 AM
Google Docs Power Point Short cuts / Insert Image etc	Rado	PowerPoint	4	04-11-2014 03:50 AM