如何在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