执行 'while' 循环时 word 宏崩溃

Question

我有一个 VBA 宏 (Word2010) 脚本来突出显示所有斜体文本。但是当在大文件中执行时，比如一个超过 10 页的文档，Word 会崩溃。为此，我使用了以下代码。

Sub Italics_Highlight()
'
' test_italics_highlight_ Macro
'
'
    Application.ScreenUpdating = False
    Dim myString As Word.Range
    Set myString = ActiveDocument.Content
    With myString.Find
        .ClearFormatting
        .Text = ""
        .Font.Italic = True
        While .Execute
            myString.HighlightColorIndex = wdTurquoise
            myString.Collapse wdCollapseEnd
        Wend
    End With
    MsgBox "Thank you!"
End Sub

你能帮忙克服这个问题吗？提前感谢您的帮助。

Answer 1

您的错误描述看起来您的代码运行永远无法完成。

您可能想在 While 循环中添加一个 DoEvents 以在运行代码时保持 Word 响应。

With myString.Find
    .ClearFormatting
    .Text = ""
    .Font.Italic = True
    While .Execute
        DoEvents 'keeps Word responsive
        myString.HighlightColorIndex = wdTurquoise
        myString.Collapse wdCollapseEnd
    Wend
End With

我不确定您的代码是否会停止。循环可能不会在文档末尾停止，而是从头开始，因此总是一次又一次地找到斜体的东西，永远循环。

因此您可能需要将 .Wrap = wdFindStop 设置为在文档末尾停止。
参见 Find.Wrap Property (Word)。

With myString.Find
    .ClearFormatting
    .Text = ""
    .Font.Italic = True
    .Wrap = wdFindStop 'stop at the end of the document
    While .Execute
        DoEvents 'keeps Word responsive
        myString.HighlightColorIndex = wdTurquoise
        myString.Collapse wdCollapseEnd
    Wend
End With

Answer 2

您无需在每个 "found" 处停下来应用突出显示。您可以将其作为 Find/Replace:

的一部分

Sub testInfiniteLoop()
    Dim myString As word.Range

    Set myString = ActiveDocument.content
    Options.DefaultHighlightColorIndex = wdTurquoise
    With myString.Find
      .ClearFormatting
      .Text = ""
      .Font.Italic = True
      .Replacement.Text = ""
      .Replacement.Highlight = wdTurquoise
      .wrap = wdFindStop 'stop at the end of the document
      .Execute Replace:=wdReplaceAll
    End With
End Sub

Answer 3

以下代码不仅突出显示而且还恢复以前有效的任何突出显示设置：

Sub Italics_Highlight()
Application.ScreenUpdating = False
Dim i As Long: i = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdTurquoise
With ActiveDocument.Content.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = ""
  .Replacement.Text = "^&"
  .Replacement.Highlight = True
  .Format = True
  .Font.Italic = True
  .Wrap = wdFindContinue
  .Execute Replace:=wdReplaceAll
End With
Options.DefaultHighlightColorIndex = i
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

如您所见，您也不需要：

Dim myString As Word.Range
Set myString = ActiveDocument.Content

执行 'while' 循环时 word 宏崩溃

word macro crashes when 'while' loop is executed

vba

ms-word

word-2010