0

Word VBA: 私の Find.Replacement コマンドは、ターゲットの最初のインスタンスのみを検索します。なんで？それ以上のインスタンスを見つけることはしません。

MY ルーチンは、指定されたスタイルを持つすべてのテキストを検索し、それを別のスタイルに置き換えることになっています。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 に答える