VBA(Word 検索文字を着色して別名保存)

https://zenn.dev/zhizhiarv/articles/3f75f8e2c75345
https://m32006400n.xsrv.jp/infrastructure/word-1485/
https://www.excel.studio-kazu.jp/kw/20210423124612.html

-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する

-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行

※ 下記設定必要
「Microsoft Word 16.0 Object Library」の参照設定

Option Explicit

Private Sub CommandButton1_Click()

'画面を更新しない
Application.ScreenUpdating = False
'確認メッセージを表示しない
Application.DisplayAlerts = False

Dim Wd As New Word.Application
Dim Doc As Word.Document

If Dir(ThisWorkbook.Path & "\" & "test2.docx") <> "" Then
    Kill ThisWorkbook.Path & "\" & "test2.docx"
End If

FileCopy ThisWorkbook.Path & "\" & "test.docx", ThisWorkbook.Path & "\" & "test2.docx"

Set Doc = Wd.Documents.Open(ThisWorkbook.Path & "\" & "test2.docx")

With Doc.Content.Find

    .Text = "%"
    '.Replacement.Text = "XXX"
    .Replacement.Font.ColorIndex = wdRed
    .Execute Replace:=wdReplaceAll

End With

Doc.Save
Doc.Close

Wd.Quit
Set Doc = Nothing
Set Wd = Nothing

MsgBox "処理完了"

'確認メッセージを表示する
Application.DisplayAlerts = True
'画面を更新する
Application.ScreenUpdating = True

End Sub