Second Do While语句未触发

时间:2019-03-03 00:27:50

标签: vba ms-word

第二条“ Do While语句”未执行。第一步是找到字符“ <<”,然后将选择范围扩展到“ >>”,然后以黄色突出显示。这些代码块在单独执行时有效。

Promise

结束子

2 个答案:

答案 0 :(得分:0)

可以尝试修改后的代码

Sub AcceptChanges()
Dim WordContentt As Word.Range
Dim sFindText As String
Dim LastDigits As String

Set WordContentt = ActiveDocument.Content
sFindText = "<<"
With WordContentt.Find

    Do While .Execute(Findtext:=sFindText)
      LastDigits = Right(WordContentt.Sentences(1), 2)
        If InStr(LastDigits, ".") > 0 Then
        WordContentt.Sentences(1).Select
        Word.Selection.MoveRight Unit:=wdCharacter, Count:=-2, Extend:=wdExtend
        Word.Selection.Range.Revisions.RejectAll
        Else
        WordContentt.Sentences(1).Select
        Word.Selection.Range.Revisions.RejectAll
        End If
    Loop
End With

Word.Selection.HomeKey
Set WordContentt = ActiveDocument.Content ' added after find range WordContentt used to be redefinerd

With WordContentt.Find

Do While .Execute(Findtext:=sFindText)
    WordContentt.Select                      ' modified
    Word.Selection.MoveEndUntil Cset:=">>"
    Word.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Word.Selection.Range.HighlightColorIndex = 7
Loop

End With
End Sub

答案 1 :(得分:0)

尝试以下代码:

我添加了评论以解释操作。

Sub AcceptChanges()

    Dim WordContentt As Word.Range
    Dim sFindText As String
    Dim LastDigits As String

    Dim startText As String
    Dim endText As String

    Set WordContentt = ActiveDocument.Content

    sFindText = "<<"

    With WordContentt.Find

        Do While .Execute(Findtext:=sFindText)

            LastDigits = Right(WordContentt.Sentences(1), 2)

            If InStr(LastDigits, ".") > 0 Then

                WordContentt.Sentences(1).Select
                Word.Selection.MoveRight Unit:=wdCharacter, Count:=-2, Extend:=wdExtend
                Word.Selection.Range.Revisions.RejectAll

            Else

                WordContentt.Sentences(1).Select
                Word.Selection.Range.Revisions.RejectAll

            End If

        Loop
    End With

    ' To begin searching the whole document again
    Set WordContentt = ActiveDocument.Content

    ' You have to escape the characters with "\" otherwise they are invalid
    startText = "\<\<"
    endText = "\>\>"

    ' Clear formatting to be sure there's nothing saved in the settings before
    WordContentt.Find.ClearFormatting
    WordContentt.Find.Replacement.ClearFormatting

    With WordContentt.Find
        ' This will look for text contained between start and end text
        .Text = startText & "*" & endText
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        WordContentt.Find.Execute

        ' Loop to find in the whole document
        While WordContentt.Find.Found
            WordContentt.HighlightColorIndex = 7
            WordContentt.Find.Execute
        Wend

    End With

End Sub