时间戳

首页 > 解决方案 > 宏 (VBA) 使 Microsoft word 崩溃（查找和替换）

vba - 宏 (VBA) 使 Microsoft word 崩溃（查找和替换）

问题描述

我使用 VBA 代码批量查找和替换突出显示的文本。宏查找并替换文档中的单词。它适用于小文档（1-2 页）上的一些突出显示的文本。但是，当我在超过 100 页的大型文档上使用此宏时，Microsoft Word 崩溃并变得无响应，因此我不得不强制退出。

该代码旨在帮助您轻松编辑信息。我正在用 XXXXX 和突出显示的黑色替换表格中也出现的突出显示文本。

有没有人有任何提示可以使代码更高效？

这是代码

Sub FindandReplaceHighlight()
  Dim strFindColor As String
  Dim strReplaceColor As String
  Dim strText As String
  Dim objDoc As Document
  Dim objRange As Range
 
  Application.ScreenUpdating = False
 
  Set objDoc = ActiveDocument
 
  strFindColor = InputBox("Specify a color (enter the value):", "Specify Highlight Color")
  strReplaceColor = InputBox("Specify a new color (enter the value):", "New Highlight Color")
  strText = InputBox("Specify a new text (enter the value):", "New Text")
  
  With Selection
    .HomeKey Unit:=wdStory
    With Selection.Find
      .Highlight = True
 
      Do While .Execute
        If Selection.Range.HighlightColorIndex = strFindColor Then
          Set objRange = Selection.Range
          objRange.HighlightColorIndex = strReplaceColor
          objRange.Text = strText
          objRange.Font.ColorIndex = wdBlack
          Selection.Collapse wdCollapseEnd
        End If
      Loop
    End With
  End With
 
  Application.ScreenUpdating = True
End Sub

标签： vbams-word

解决方案

尝试：

Sub FindandReplaceHighlight()
Application.ScreenUpdating = False
Dim ClrFnd As Long, ClrRep As Long, strTxt As String
Const StrColors As String = vbCr & _
"  1 Black" & vbCr & _
"  2  Blue" & vbCr & _
"  3  Turquoise" & vbCr & _
"  4  Bright Green" & vbCr & _
"  5  Pink" & vbCr & _
"  6  Red" & vbCr & _
"  7  Yellow" & vbCr & _
"  8  White" & vbCr & _
"  9  Dark Blue" & vbCr & _
"10 Teal" & vbCr & _
"11 Green" & vbCr & _
"12 Violet" & vbCr & _
"13 Dark Red" & vbCr & _
"14 Dark Yellow" & vbCr & _
"15 Gray 50" & vbCr & _
"16 Gray 25%"
 
ClrFnd = InputBox("Specify the old color (enter the value):" & StrColors, "Specify Highlight Color")
ClrRep = InputBox("Specify the new color (enter the value):" & StrColors, "New Highlight Color")
strTxt = InputBox("Specify the new text (enter the value):", "New Text")
  
With ActiveDocument
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Highlight = True
      .Forward = True
      .Wrap = wdFindStop
    End With
    Do While .Find.Execute
      If .HighlightColorIndex = ClrFnd Then
        .HighlightColorIndex = ClrRep
        .Text = strTxt
        .Font.ColorIndex = wdBlack
        .Collapse wdCollapseEnd
      End If
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub

推荐阅读