在搜索和替换词中使用宏 VBA

Question

我正在尝试开发一段代码，从文本中提取某些名称（Kennedy、Nixon 等）并用带标记的名称替换它们（@Kennedy、@Nixon。由于涉及时间，我会喜欢使用数组。我尝试了多个示例，但没有运气。我能找到的最佳模型如下：

Sub Macro1()

Dim i As Variant
Dim NameOrig As Variant
Dim NameSub As Variant
NameOrig = Array("McGee", "NIXON", "KENNEDY")
NameSub = Array("@McGee", "@NIXON", "@KENNEDY")
With ActiveDocument.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  For i = 1 To UBound(NameOrig)
    .Text = NameOrig(i)
    .Replacement.Text = NameSub(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
End Sub

最终我得到一个运行-Time error'438': Object doesn't support this 属性 or method。有没有办法来解决这个问题？或者还有另一段代码可以实际运行。

Answer 1

您需要使用 'ActiveDocument.Content.Find' 或 'ActiveDocument.Range.Find'。您也不需要 'Dim NameSub As Variant'、'NameSub = Array("@McGee", "@NIXON", "@KENNEDY")' 或 '.Replacement.Text = NameSub(i)'。最后，除非您设置了 'Option Base 1'，否则如果您不从 0 开始循环，您将错过第一项。尝试：

Sub Macro1()
Dim i As Long, NameOrig As Variant
NameOrig = Array("McGee", "NIXON", "KENNEDY")
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .Replacement.Text = "@^&"
  For i = 0 To UBound(NameOrig)
    .Text = NameOrig(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
End Sub

在搜索和替换词中使用宏 VBA

Using Macros in Search and Replace Word VBA

vba

full-text-search

replace

ms-word