Word VBA:我的'Find.Replacement'命令只查找Find目标的第一个实例。为什么?

时间:2013-10-29 23:34:45

标签: vba ms-word word-vba

Word VBA:我的Find.Replacement命令只会找到目标的第一个实例。为什么?它不会继续发现更多实例。

我的例程应该找到具有指定样式的所有文本,并将其替换为另一种样式。 IT只找到第一个实例。

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 个答案:

答案 0 :(得分:0)

试试这个......

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