执行“while”循环时，word 宏崩溃答案

【问题标题】：word macro crashes when 'while' loop is executed执行“while”循环时，word 宏崩溃
【发布时间】：2018-08-27 17:15:01
【问题描述】：

我有一个 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

请您帮忙解决这个问题。提前感谢您的帮助。

【问题讨论】：

“Word 崩溃”到底是什么意思，它像强制关闭一样崩溃而没有任何错误消息吗？或者它是否显示错误消息？如果是强制关闭，则将您的 Office 升级到最新版本，如果仍然出现，则为错误，您需要联系 Microsoft 支持。请注意：如果您禁用屏幕更新Application.ScreenUpdating = False，请不要忘记在最后启用它，否则它可能会在您完成程序后被禁用。
我可以给你两个猜测。首先，可能是您的文档在某处有一些奇怪的样式格式，例如，斜体文本的发现部分从表格内部延伸到下一段。这通常应该不是问题，但有时人们倾向于通过复制/粘贴、更改标记等来搞乱他们的文档……第二个猜测是你的 word/计算机有点慢，并告诉你 Word 是“不是回应”。尝试通过使用逐步和/或断点来调试代码以找出问题发生的位置
感谢您的更新。我最后添加了 Application.ScreenUpdating = True 我忘了在这里添加它。我的意思是 MS Word 变得完全没有反应。运行此代码后，我无法再做任何事情。我仍然可以看到突出显示已完成。任务管理器中的文件状态更改为“未响应”

标签： vba ms-word word-2010

【解决方案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

【讨论】：

非常感谢@PEH 'DoEvents' 的解决方案现在完美运行。你是对的，循环永远不会结束，因为如果我将任何文本更改为斜体，我仍然可以看到它会自动突出显示斜体。这里 '.Wrap = wdFindStop' 似乎不起作用。
@vikashvishnu 在 StackOverflow 上，感谢某人贡献的公认方式是在其旁边点赞（单击箭头）。要让每个人都知道某个贡献回答了您的问题，请单击它旁边的复选标记。这也将在网站上为贡献者提供“积分”。
@vikashvishnu "似乎不起作用" 完全没有意义。你需要告诉实际发生了什么。使用.Wrap = wdFindStop Find 函数肯定会在我刚刚测试代码的文档末尾停止。所以你一定做错了什么。您可以通过在文档中仅使用 2 或 3 个斜体字来轻松测试这一点。它将以MsgBox "Thank you!" 停止。
我的意思是说即使在使用.Wrap = wdFindStop 之后，我的循环仍然会继续。我还添加了MsgBox "Thank you!" 来检查循环是否结束但它仍然继续。如果文档大小很小，比如 4 页，我会收到消息框，如果超出此范围，则不会收到任何消息框。

【解决方案2】：

您不需要在每个“找到”处停下来并应用突出显示。您可以将其作为查找/替换的一部分：

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

【讨论】：

【解决方案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

【讨论】：