Batch replace Header and Footer and QuickStyle

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

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