Help with mass image insert on Header and Footers

[alundra828]

Morning all, I'm fairly new to VB, and am having trouble with a little task I've been given.

I've written a whole program that finds and replaces text on an unlimited number of documents, it changes merge fields, and stuff in the header and footer and all that good stuff.

The problem I've now been presented with is that clients want to mass insert images. You see, my clients have about 500 documents all with the same header, and footer image taking up the entire section in the form of .PNG's. I was wondering if there was any code any of you can conjure up that will help me mass insert a new .PNG header and footer to replace the old ones?

They are using word 2003. Any help would be much appreciated! My deadline is fast approaching!

[gmayor]

Assuming that the same logo is used throughout then you could call the following macro from your looping macro to replace the header with the new logo (or use the test macro to process the active document).

In order to use the macro first open a document that needs changing and insert the new header logo(s) exactly as required. Select everything in the header then Press ALT+F3. Save in the normal template as 'NewHeaderLogo'. Repeat for the footer calling the autotext 'NewFooterLogo'

When you run the macro any header or footer that contains a graphic is replaced with a field that calls the new autotext entry. If you want to limit it to specific sections or specific header/footers then you can do that easily enough.




Sub ReplaceLogos(oDoc As Document)
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter
Dim oHRange As Range
Dim oFRange As Range
For Each oSection In oDoc.Sections
For Each oHeader In oSection.Headers
If oHeader.Shapes.Count > 0 Or _
oHeader.Range.InlineShapes.Count > 0 Then
Set oHRange = oHeader.Range
oHRange.Text = ""
oDoc.Fields.Add _
Range:=oHRange, _
Type:=wdFieldAutoText, _
Text:="NewHeaderLogo", _
PreserveFormatting:=False
oHeader.Range.Fields.Update
oHeader.Range.Fields.Unlink
End If
Next oHeader
For Each oFooter In oSection.Footers
If oFooter.Shapes.Count > 0 Or _
oFooter.Range.InlineShapes.Count > 0 Then
Set oFRange = oFooter.Range
oFRange.Text = ""
oDoc.Fields.Add _
Range:=oFRange, _
Type:=wdFieldAutoText, _
Text:="NewFooterLogo", _
PreserveFormatting:=False
oFooter.Range.Fields.Update
oFooter.Range.Fields.Unlink
End If
Next oFooter
Next oSection
lbl_Exit:
Set oSection = Nothing
Set oHeader = Nothing
Set oFooter = Nothing
Set oHRange = Nothing
Set oFRange = Nothing
Exit Sub
End Sub

Sub Test()
ReplaceLogos ActiveDocument
lbl_Exit:
Exit Sub
End Sub

[SSALVI2604]

Hi I need to find & replace a text of a footer in multiple word files say approx 200. could you olease guide me on the vba to edit footer on a unlimited documents of a given folder path. word 2010 & word 2013.
Thanks

[gmayor]

You could use one of the replace option functions in the following link or modify the macro in this thread to work as a custom process, but without knowing what it is that you want to change it is difficult to be specific.

http://www.gmayor.com/document_batch_processes.htm (http://www.gmayor.com/document_batch_processes.htm)

[SSALVI2604]

Thnks Graham .... in the footer of approx 200 word foles i need to find "section - business process " and replace with "chapter- sop". Could you please help me with a macro ??? As im just a begineer in vba...

[gmayor]

If the text 'section - business process' only appears in the footer (and not in the header or the body) then you don't need a macro. The Replace function in the linked process will address it.