Batch replace Header and Footer and QuickStyle

Artmax · #1 06-18-2017, 06:53 PM

Like many before me i have a need to process a couple of hundred documents to create a uniform header and footer across the documents.

I have tried and failed to find a ready made macro which works for my purposes and have tried editing them but always end up with errors - I don't know head from tail in vba - but a vast majority of the ones came from this forum so I thought I'd try here.

Tried but it results in an error: 'Only comments may appear after End Sub, End Function or End Prop'
Tried too Compile error

I don't know where it might go wrong, could well be a dodgy operator (i.e. me)

Some difficulties/requirements:
1. Not all headers or footers are uniform across the files I need to replace.So haven't been able to get Find/Replace to work.
2. Header contains an image.
3. Need a QuickStyle applied to docs as well.

I have created Autotexts for headers and footers - @header and @footer and have setup a QuickStyle but cannot get them all to work together.

I would love to be able to point at a folder and for it to just run through and save them all(and subfolders if possible - but happy to go folder by folder - it will still save me hundreds of hours)
I'm using Office 2016 on Windows 10 if it makes a difference

Thank you for your generous help

gmayor · #2 06-18-2017, 08:27 PM

It is fairly straightforward to replace all the headers/footers regardless with the same header footer, by removing the existing header footer contents and writing a new header footer to the header footer ranges. The problem is that there are up to three header footer ranges for each section of the document. Which header/footers do you want to change.

Even more pertinent, why do you want you change the header/footers of all the old documents? New documents I can understand, but old documents would then no longer reflect the content at the time the document was produced. This can be important for letters and especially documents of a legal nature.

Artmax · #3 06-18-2017, 08:48 PM

Hi Gmayor,

Essentially this is a rebranding exercise. I have a ton of documents created over the years by different people which have used different formatting different fonts (Times, Calibri, Arial) and different Headers. The information is still being distributed but I want it all to look like a uniform body of work rather than a collection created by many different people. It's not legal documents or anything just processes/handbook type docs.

Quote:

The problem is that there are up to three header footer ranges for each section of the document. Which header/footers do you want to change.

I'm not 100% sure what you mean here (low word literacy i'm afraid)do you mean the 'different first page, different for Even/Odd pages'?
I just need one Header and one Footer for the whole document (I don't think many of them would even have multiple sections, but regardless just the same Header and the Same Footer.)

Thank you.

gmayor · #4 06-18-2017, 11:50 PM

OK. In that case the following function will do that. The function is written to work as a user defined process with http://www.gmayor.com/document_batch_processes.htm which will handle the folders/documents, or you can call it from your own document selection process.

Basically it replaces any (or no) header and footer with the autotext entries from the normal template called @header and @footer, that you said you have created.

If you use the batch processor, ensure that you test it first on a single document to ensure that the autotexts do indeed produce the required results, before processing all the documents in a folder.

Code:

Function MyHeader(oDoc As Document)
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter
Dim strTemplate As String
Dim orng As Range
    strTemplate = Application.Options.DefaultFilePath(wdUserTemplatesPath)
    strTemplate = strTemplate & "\Normal.dotm"

    On Error GoTo err_Handler
    For Each oSection In oDoc.Sections
        For Each oHeader In oSection.Headers
            If oHeader.Exists Then
                Set orng = oHeader.Range
                orng.Text = ""
                Application.Templates _
                        (strTemplate).AutoTextEntries("@header").Insert Where:=orng, _
                                                                        RichText:=True
            End If
        Next oHeader
        For Each oFooter In oSection.Footers
            If oFooter.Exists Then
                Set orng = oFooter.Range
                orng.Text = ""
                Application.Templates _
                        (strTemplate).AutoTextEntries("@footer").Insert Where:=orng, _
                                                                        RichText:=True
            End If
        Next oFooter
    Next oSection
    MyHeader = True
lbl_Exit:
    Exit Function
err_Handler:
    MyHeader = False
    Resume lbl_Exit
End Function

Artmax · #5 06-19-2017, 05:59 PM

Wow, Thank you so much.
That Batch Processor is incredible.

I had a few issues with the autotext formatting being messed up but I've fixed it by defining the text as it's own style. Is there any other way to accomplish this? (just for my own knowledge)

Speaking of Styles, could you please show me how to change a Style Set in this process. I have a custom style saved as Template and would love for it to be applied as well.

Edit: So I've found that It's a simple line through Macro-recorder. If I wanted to build my own function could I make it something like:

Code:

Function changeStyle(oDoc As Document) As Boolean
On Error GoTo Err_Handler
'Do Something with oDoc here. e.g.,"
oDoc.ApplyQuickStyleSet2 ("Template")
MyUserDefinedProcess = True
lbl_Exit:
Exit Function
Err_Handler:
Select Case Err.Number
'Case Is = "Your handled errors e.g., 5109"
Case Else
MyUserDefinedProcess = False
Resume lbl_Exit
End Select
End Function

Thanks again.

gmayor · #6 06-19-2017, 08:09 PM

You can of course create your own functions, but for it to work correctly with the add-in you need to follow the format set out on the web page - in particular the items commented below. Different Word versions use style sets differently, but if the recorder gives the style set name as you have it it will probably work in your version.

Code:

Function changeStyle(oDoc As Document) As Boolean
    On Error GoTo Err_Handler
    'Do Something with oDoc here. e.g.,"
    oDoc.ApplyQuickStyleSet2 ("Template")
    changeStyle = True 'the name of the function = true
lbl_Exit:
    Exit Function
Err_Handler:
    changeStyle = False 'the name of the function = false
    Err.Clear
    GoTo lbl_Exit
End Function

You can also apply individual styles to the header footer ranges (or parts of the ranges) in the original macro, but the styles should be stored in the autotext entries and so this should be unnecessary. The problem will be that you have different styles with the same names in the target documents, so you could copy the styles used in your autotexts from the normal template to the document, which can be done in the same macro or perhaps better still use unique style names for your header and footer in the autotext so there is no conflict.

Artmax · #7 06-19-2017, 08:29 PM

Thanks.
If i wanted to combine functions ois it okay to add oDoc.ApplyQuickStyleSet2 ("Template") after the 'On Error...'?
It seems to function but I may be missing some issue that I don't know about.

EDIT: Doesn't seem to work with Batch Processing.

EDIT: Subfolder Processing doesn't seem to work for multiple folders - It only processes the first folder in the stack

eg. -
\TopFolder\Sub1\
\TopFolder\Sub2\

It processes files in TopFolder and in Sub1 but not files in Sub2.

Am I missing something?

Thanks again

Artmax · #8 06-20-2017, 03:27 PM

Gmayor, or others,

Is there anyway to use your amazing machine to find fonts and replace with font rather than words only?
I know you can do this with the advanced find, but not sure how I would specify it.

Thanks again for all of your help.

gmayor · #9 06-20-2017, 08:33 PM

You can use the custom process to perform just about anything that can be achieved with VBA. You can certainly add code to the initial process I posted to change style sets, add fonts, change fonts or create a second process to be run separately to achieve any or all of these things.

Test your code out on the current document before applying it to all your documents.

The add-in should also process all the folders under the selected top folder and certainly does here - check the log. It won't process folders that don't contain documents.

Artmax · #10 06-21-2017, 01:32 AM

Okay, So I have tried to develop a script for finding text in a particular font ("Segoe Script") and then updating that text to a Style (which has Arial font... but I wanted the option to change the styles in the future hense not a straight font change)
It's based on a macro record for the search - this proved unhelpful as I don't know how it selects or activates.

It runs without error but doesn't do anything.

Code:

Function FontStyle(oDoc As Document) As Boolean
Dim oSection As Section
    On Error GoTo Err_Handler
    'Do Something with oDoc here. e.g.,"
           oDoc.Range.Find.ClearFormatting
            With Range.Find
                .Text = ""
                .Font.Name = "Segoe Script"
                .Replacement.Text = ""
                .Replacement.Style = ActiveDocument.Styles("AsideStyle")
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Excecute Replace:=wdReplaceAll
            End With
        
    FontStyle = True 
lbl_Exit:
    Exit Function
Err_Handler:
    FontStyle = False 
    Err.Clear
    GoTo lbl_Exit
End Function

FYI This is the code which is created in the recorded Macro - Doesn't seem to even select the font in the recording.

Code:

Sub font()
'
' font Macro
'
'
Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("ASideStyle")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

I've looked over so many other things to make a selection, but can't get anything to work. Any ideas?

:/

gmayor · #11 06-21-2017, 04:05 AM

It would not run without error if you removed the on error line.

The following should do what you suggest, though whether it works entirely as you intend will depend on whether the text comprises of manual formatting over an existing style, how much of the paragraph is manually formatted and whether you are applying a paragraph style or a character style. i.e. it obeys the rules relating to the application of styles and manually formatting.

It will work best if the whole paragraph is formatted with Segoe Script and the style is a paragraph style and not a character style OR if not, the style is a character style

The first macro will process just the document body, the second will process all the document ranges i.e. including headers and footers.

Code:

Function FontStyle(oDoc As Document) As Boolean
Dim oRng As Range
    On Error GoTo Err_Handler
    Set oRng = oDoc.Range
    oRng.Find.ClearFormatting
    oRng.Find.Replacement.ClearFormatting
    With oRng.Find
        .Text = ""
        .Font.Name = "Segoe Script"
        Do While .Execute
            oRng.Style = "AsideStyle"
            oRng.Collapse 0
        Loop
    End With
    FontStyle = True
lbl_Exit:
    Exit Function
Err_Handler:
    FontStyle = False
    Err.Clear
    GoTo lbl_Exit
End Function


Function FontStyle2(oDoc As Document) As Boolean
Dim oRng As Range
    On Error GoTo Err_Handler
    For Each oRng In oDoc.StoryRanges
        oRng.Find.ClearFormatting
        oRng.Find.Replacement.ClearFormatting
        With oRng.Find
            .Text = ""
            .Font.Name = "Segoe Script"
            Do While .Execute
                oRng.Style = "AsideStyle"
                oRng.Collapse 0
            Loop
        End With
        If oRng.StoryType <> wdMainTextStory Then
            While Not (oRng.NextStoryRange Is Nothing)
                Set oRng = oRng.NextStoryRange
                oRng.Find.ClearFormatting
                oRng.Find.Replacement.ClearFormatting
                With oRng.Find
                    .Text = ""
                    .Font.Name = "Segoe Script"
                    Do While .Execute
                        oRng.Style = "AsideStyle"
                        oRng.Collapse 0
                    Loop
                End With
            Wend
        End If
    Next oRng
    FontStyle2 = True
lbl_Exit:
    Exit Function
Err_Handler:
    FontStyle2 = False
    Err.Clear
    GoTo lbl_Exit
End Function

Artmax · #12 06-22-2017, 01:12 AM

Hi GMayor,

I know i'm always coming with problems.
I've been testing them and hav ehad no issue except for the one that I put together (with your help of course), it works when applied to a single file but not when run over a folder. :\

Code:

Function changeStyle(oDoc As Document) As Boolean
    On Error GoTo Err_Handler
    oDoc.ApplyQuickStyleSet2 ("Template")
    changeStyle = True 'the name of the function = true
lbl_Exit:
    Exit Function
Err_Handler:
    changeStyle = False 'the name of the function = false
    Err.Clear
    GoTo lbl_Exit
End Function

(this may or may not be useful information for you)
I've looked over the web and there is very little written about ApplyQuickStyleSet2 but there are some contradictory examples of how to run it, I have tried different things while removing the error code catcher to see if I could learn anything (I didn't)

Code:

Function changeStyle(oDoc As Document) As Boolean
Dim Template As String


    
    'Do Something with oDoc here. e.g.,"
    oDoc.ApplyQuickStyleSet2 (Template)
    
End Function

This code seemed to be the most successful, in that it gave me a error that seemed to make sense.
"Run-Time Error 6209
Cannot load the requested Quick Style Set. Please check the set name and try again."

Even setting it to a standard word style set results in the same error, so may be nothing.

It seems strange that it would work only in one document and not across the folder (These are literally the same files and folder structure tested document to document and folder by folder)

Side note: not sure if this is possible as the macro recorder threw up nothing, but one or two of the documents had locked style sets, and obviously wouldn't work. Whne I manually opened them they were fine. Do you know of a way to unlock them in the code? - it's not a big deal and you hav ealready done so much.
Thank you again.

gmayor · #13 06-22-2017, 01:53 AM

I suspect that the error is self explanatory. The styleset (non standard) is available in the document in which it worked but is not available in the other documents in which it doesn't.

Frankly I wouldn't personally use style sets for this. I would create the style(s) that I wanted in a template (or document), then use the function to copy the style(s) from the template/document to the document under process (oDoc), apply the style(s) to the range(s) (oRng) as required and then reset the range to show the style settings that you have applied.

This code below is for one style, but you can sequentially copy other named styles similarly and move the range to its new location before applying them.

Code:

Dim oSource As Document
Const strStyle As String = "AsideStyle"    'The style to copy
    'open the template with the styles to be copied to the document
    Set oSource = Documents.Open _
                  (FileName:="C:\Path\TemplateName.dot", _
                   Visible:=False)

    Application.OrganizerCopy Source:= _
                              oSource.FullName, Destination:= _
                              oDoc, _
                              Name:=strStyle, _
                              Object:=wdOrganizerObjectStyles
    With oRng    'apply the style to the range
        .Style = strStyle
        .Font.Reset
        .ParagraphFormat.Reset
    End With

jchess · #14 01-11-2024, 01:32 PM

hi guys i need to replace all the right footers of every excel file in a folder with a new text string. and i'm not quite finding what i'm looking for. it's a large stack of files almost 2800 workbooks and i'd like it to do every sheet in each workbook. 3 max. is this something you could help me with?

Guessed · #15 01-11-2024, 05:36 PM

jchess

Please don't add posts inside threads which are unrelated to the existing topic. This is a new question that should be moved to the Excel Programming section - it doesn't belong in this particular area which is focused on Word VBA.

Your question has components which should be developed and tested in chunks.

First, work out what lines of code are needed to set the footer on one sheet. The easiest way to do this is to start the macro recorder, go into the Page Setup and set the right footer the way you want it, hit OK and stop the macro recorder. Then go and look at the code you recorded, it will look something like the following. I've bolded the lines which relate to your specific question although you may decide you want to include some of the other lines if they also need to be standardised across the workbooks:

Code:

Sub Macro1()
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "My right side text in footer"
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 1200
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = 211
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
End Sub

Once you have your relevant lines, you can put them into a structure that updates the right footer in ALL sheets in the current workbook. This can't be recorded so you need to write it along the following lines using info harvested from your recording. If you aren't touching any other footer settings then you can simplify the With/End With parts too.

Code:

Sub MyRightFoot()
  Dim aWB As Workbook, aSht As Worksheet
  Set aWB = ActiveWorkbook
  For Each aSht In aWB.Sheets
    aSht.PageSetup.RightFooter = "My right side text in footer"
  Next aSht
End Sub

If you test that code and are happy with the results on a couple of test workbooks, you can work out how to apply that to a folder containing many workbooks. I'm sure you can find batch macros in the Excel Programming section of this site but if not, do a wider Google search.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find & Replace in Header/Footer in 1000 files	amodiammmuneerk@glenmarkp	Word	12	03-05-2018 03:31 AM
New to VBA - Find/Replace in MS Word 2010 that Searches Header/Footer	mbreggs	Word VBA	4	06-01-2016 08:02 AM
Find/replace font colour in all header/footer	trillium	Word VBA	4	10-20-2015 10:39 PM
Created VBA to Find and Replace in Body, Header and Footer with Highlighting the replacement text	QA_Compliance_Advisor	Word VBA	11	09-23-2014 04:40 AM
Find & Replace in Header/Footer	PReinie	Word	6	01-22-2014 06:45 PM