如何在Word中使用VBA同时替换形状中的单词（不通过形状循环）

Question

我有一个包含约1000个用于替换的单词对的列表。通过循环遍历形状，我必须一次又一次地遍历单词对。为了让它运行得更快，我尝试在执行替换之前选择所有形状，但它不起作用。任何建议将不胜感激。

的电流代码（对存储在一个名为密钥列表（）和一个名为颂歌字典）

相关部分：

With Selection.Find 
    .ClearFormatting 
    .Replacement.ClearFormatting 
    .Forward = True 
    .Wrap = wdFindContinue 
    .Format = False 
    .MatchCase = False 
    .MatchWholeWord = False 
    .MatchByte = False 
    .MatchAllWordForms = False 
    .MatchSoundsLike = False 
    .MatchWildcards = False 
    .MatchFuzzy = False 
End With 
shape_num = ActiveDocument.Shapes.count 
On Error GoTo errhandler 

For i = 1 To shape_num 
    If ActiveDocument.Shapes(i).TextFrame.HasText Then 
     ActiveDocument.Shapes(i).Select 
     For j = 1 To lexicon_num 
      SrcText = key(j) 
      With Selection.Find 
       .Text = SrcText 
       .Replacement.Text = oDic.Item(SrcText) 
       .Execute Replace:=wdReplaceAll 
      End With 
     Next j 
    End If 
    continue_shape: 
Next i 
exit sub 
errhandler: 
Err.Clear 
Resume continue_shape 

Answer 1

请注意，回答您的具体问题是：不，是不可能在Word中使用VBA一次性替换形状中的单词（不通过形状循环）

但是，我的印象是，您实际上感兴趣的是如何优化代码的更一般问题。以下是一个解决方案。

我建议在评论中实现Trie，但经过进一步考虑后，我认为内置的Scripting.Dictionary对象已经足够满足您的需求。

我建议你加载一个Scripting.Dictionary用你想找到的词（作为键）并替换（作为值）。您可以循环一次每个形状的文字并检查Scripting.Dictionary以查看它是否存在。如果有，请更换它;如果没有，请保持独立。

我创建了一个矩形文字“这个形状有单词”找到“在里面。”其中“发现”是粗体和红色。我对它进行了测试，用“替换”代替“查找”，格式保持不变。

下面是示例代码：

Public Sub Main() 
    Dim dictFindReplace As Scripting.Dictionary 

    Set dictFindReplace = New Scripting.Dictionary 

    'Add all your words to the dictionary here 
    dictFindReplace.Add "find", "replace" 

    'Loop through all the shapes 
    For i = 1 To ActiveDocument.Shapes.Count 

     'If the shape has text 
     If ActiveDocument.Shapes(i).TextFrame.HasText Then 
      With ActiveDocument.Shapes(i).TextFrame.TextRange.Words 
       'Loop through each word. This method preserves formatting. 
       For j = 1 To .Count 

        'If a word exists in the dictionary, replace the text of it, but keep the formatting. 
        If dictFindReplace.Exists(.Item(j).Text) Then 
         .Item(j).Text = dictFindReplace.Item(.Item(j).Text) 
        End If 
       Next 
      End With 
     End If 
    Next i 

End Sub