0
votes

Word VBA: My Find.Replacement command will only find the first instance of the target. Why? It does not not go on to find further instances.

MY routine is supposed to find all text with a specified style and replace it with another style. IT only finds the first instance.

Function ExecReplaceStyle(strSourceStyle As String, strDestinationStyle As String) As Integer
    On Error GoTo ErrorHandler

    Dim Rng As Range
    Dim ret As Integer

    ExecReplaceStyle = 0
    Set Rng = docActiveDoc.Range

    Rng.Find.ClearFormatting
    Rng.Find.Style = ActiveDocument.Styles(strSourceStyle)

    Rng.Find.Replacement.ClearFormatting
    Rng.Find.Replacement.Style = ActiveDocument.Styles(strDestinationStyle)

    With Rng.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    'Rng.Find.Execute(Replace:=wdReplaceAll)
    Rng.Select
    Rng.Find.Execute Replace:=wdReplaceAll

    ExecReplaceStyle = ret

    Exit Function

ErrorHandler:
    ExecReplaceStyle = Err.Number
    ErrDescription = Err.Description
    Resume Next
End Function
1
what is docActiveDoc? I changed this to ActiveDocument and it workssam092
Adding Option Explicit at the top of your modules will help you avoid typos/misspellings like the one that @sam092 mentions.David Zemens
You may also try putting .Execute Replace:=wdReplaceAll inside your With block, although I don't think that's the immediate cause of your problem.David Zemens
docActiveDoc is name of the variable of type Document that stores a handle to the active document.user2930201

1 Answers

0
votes

Try this ...

Function ExecReplaceStyle(strSourceStyle As String, strDestinationStyle As String) As Integer
    On Error GoTo ErrorHandler
    Dim Rng As Range
    Dim ret As Integer
    ExecReplaceStyle = 0
    Set Rng = ActiveDocument.Range
    Const sMsgTitle As String = "find and replace style"

    If False = StyleExists(strSourceStyle, ActiveDocument) Then
        Call MsgBox("Find style missing : " & strSourceStyle, vbCritical, sMsgTitle)
        Exit Function
    End If
    If False = StyleExists(strDestinationStyle, ActiveDocument) Then
        Call MsgBox("Replace style missing : " & strDestinationStyle, vbCritical, sMsgTitle)
        Exit Function
    End If

    With Rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .ClearAllFuzzyOptions
        .Text = ""
        .Style = strSourceStyle
        .Replacement.Text = ""
        .Replacement.Style = strDestinationStyle
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Rng.Select: Selection.Collapse wdCollapseStart
    Do While Rng.Find.Execute = True
        Rng.Style = strDestinationStyle: Rng.Collapse wdCollapseEnd
        ExecReplaceStyle = ExecReplaceStyle + 1
        If Rng.End = ActiveDocument.Range.End - 1 Or Rng.InRange(ActiveDocument.Bookmarks("\endofdoc").Range) = True Then Exit Do
    Loop
    Exit Function

ErrorHandler:
    ExecReplaceStyle = Err.Number
    ErrDescription = Err.Description
    Resume Next
End Function


Function StyleExists(sStyleName As String, Optional whDoc As Document = Nothing) As Boolean
Dim dsc             As String
On Error GoTo ErrHandler:
StyleExists = True
If whDoc Is Nothing Then Set whDoc = ActiveDocument
dsc = whDoc.Styles(sStyleName).Description
Exit Function
ErrHandler:
    StyleExists = False
    Err.Clear
End Function