巨集：Word 呼叫 Excel 清單批次取代

在 Microsoft Office Word 中，彰化一整天前輩寫了個巨集，可批次對多個 Word 檔案取代文字。但這不符合我的工作流程，而且這個版本只支援.doc檔。因此參考了前輩的語法，另外寫了一個巨集，在以 Word 開啟檔案的狀態下，呼叫 Excel 清單搜尋取代，且支援萬用字元。（另有LibreOffice的版本）

版本特色：

1. 支援所有可用 Word 開啟的文件
2. 支援萬用字元
3. 以 Excel 管理列表

缺點：本巨集不支援取代文字格式，且無法同時取代多個檔案。如有需要，請參考彰化一整天的巨集。

安裝

準備 Excel 取代清單

1. 開啟Excel，將第一列寫上標題：「搜尋」、「取代」、「萬用字元」。
2. 在之後的列中填入要搜尋取代的內容，中間請勿空行。如要使用萬用字元，請在該列第三欄寫上「Y」。





3. 儲存檔案。（檔名及檔案路徑避免包含與電腦系統語言不符的文字，如中文環境請勿包含日文或韓文，以免出錯）

安裝 Word 巨集

1. 開啟Word，點開「檢視」>「巨集」>「檢視巨集」。會跳出一個對話方塊，，輸入RepWithList，點「建立」，就會跳出巨集編輯視窗。



2. 在編輯視窗中，把「Sub RepWithList()」到「End Sub」這三行字取代成以下內容。

Sub RepWithList()
'
' 呼叫 Excel 清單批次取代 Replace with Excel List

' 存取表格內容====
Dim wb As Document
    Set doc = Application.ActiveDocument
    Set xlapp = CreateObject("excel.application")
    Set wkBook = xlapp.Workbooks.Open("E:\Programs\RepList_MS.xlsx")

' 定義搜尋取代變數====
    i = 2
    Org = wkBook.Worksheets(1).Cells(i, 1)
    Rep = wkBook.Worksheets(1).Cells(i, 2)
    WildcardsCheck = False
    If wkBook.Worksheets(1).Cells(i, 3) = "Y" Then WildcardsCheck = True

' 取代迴圈====
    While Org <> ""
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = Org
            .Replacement.Text = Rep
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchWildcards = WildcardsCheck
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll

        i = i + 1
        Org = wkBook.Worksheets(1).Cells(i, 1)
        Rep = wkBook.Worksheets(1).Cells(i, 2)
        WildcardsCheck = False
        If wkBook.Worksheets(1).Cells(i, 3) = "Y" Then WildcardsCheck = True
    Wend

    MsgBox "取代完成" &  Chr(13)  & "技術支援：憑虛御風 https://qingxianz.blogspot.com"

    wkBook.Close

End Sub

說明：

1. Set wkBook = xlapp.Workbooks.Open("E:\Programs\RepList_MS.xlsx")
請將紅字部分換成剛才製作的 Excel 檔案路徑。
 
2. Forward = True
如果不需往前取代，請改為False
 
3. MatchCase = False
如要區分大小寫，請改為True

安裝捷徑

1. 開啟「選項」>「快速存取工具列」中「由此選擇命令」下選擇「巨集」，找到剛才的「RepWithList」，點下去反白。
2. 在右欄選擇要加入的工具列，按中間的「➡️」加入，調整到想要的位置。
3. 點「RepWithList」，按下欄「修改」，改成想要的名稱和圖示（請勿和其他工具混淆）。按「確定」。

這樣工具列就會出現設定的圖示，按一下就會自動取代了。

如果覺得我的程式很有幫助，歡迎贊助斗內我喔(*´∀`)~♥

 PS：如要提問，請使用Facebook留言框下的內建留言板，這樣我才收得到通知。