0

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
4

1 回答 1

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
于 2013-11-12T07:53:26.173 回答