我需要为我的程序创建一个停止条件

时间:2016-01-28 13:43:28

标签: vba ms-word word-vba

我有一个程序,突出显示起点和终点之间的所有单词,并循环提取以找到相同的条件。程序运行良好,但它不会停止循环。我必须打破正在运行的程序才能阻止它。有人可以帮我写一个条件,说明如果达到目的并且开始和结束条件不存在,停止程序。

Sub SomeSub1()

Dim StartWord As String, EndWord As String
Dim Find1stRange As range, FindEndRange As range
Dim DelRange As range, DelStartRange As range, DelEndRange As range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Setting up the Ranges
Set Find1stRange = ActiveDocument.range
Set FindEndRange = ActiveDocument.range
Set DelRange = ActiveDocument.range

'Set your Start and End Find words here to cleanup the script
StartWord = "From: Yussuf Ismail"
EndWord = "Kind regards"

'Starting the Find First Word
With Find1stRange.Find
    .Text = StartWord
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

    'Execute the Find
    Do While .Execute
        'If Found then do extra script
        If .Found = True Then
            'Setting the Found range to the DelStartRange
            Set DelStartRange = Find1stRange
            'Having these Selections during testing is benificial to test your script
            DelStartRange.Select

            'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
            FindEndRange.Start = DelStartRange.End
            FindEndRange.End = ActiveDocument.Content.End

            'Having these Selections during testing is benificial to test your script
            FindEndRange.Select


            'Setting the Find to look for the End Word
            With FindEndRange.Find
                .Text = EndWord
                .Execute

                'If Found then do extra script
                If .Found = True Then
                    'Setting the Found range to the DelEndRange
                    Set DelEndRange = FindEndRange

                    'Having these Selections during testing is benificial to test your script
                    DelEndRange.Select

                End If

            End With

            'Selecting the delete range
            DelRange.Start = DelStartRange.Start
            DelRange.End = DelEndRange.End
            'Having these Selections during testing is benificial to test your script
            DelRange.Select
DelRange.HighlightColorIndex = wdPink
            'Remove comment to actually delete




        End If      'Ending the If Find1stRange .Found = True
    Loop        'Ending the Do While .Execute Loop
End With    'Ending the Find1stRange.Find With Statement


End Sub

1 个答案:

答案 0 :(得分:0)

由于subprocess.Popen

,它一直在继续

这将删除"搜索已到达文档的末尾。你想在一开始就继续搜索吗?"消息。

如果您删除了yes = subprocess.Popen(['yes', '""'], stdout=subprocess.PIPE) proc = subprocess.Popen(['foo', 'bar'], stdin=yes.stdout, stdout=subprocess.PIPE) ,那么它将在文档末尾停止,并会弹出该消息。

同时更改初始Application.DisplayAlerts = False中的以下内容:

Application.DisplayAlerts = False

Find

这样就不会问问题而只是停止.Wrap = wdFindAsk