【Excel VBA】置換リストで都度確認しながらWord文書の文字列を置換

前回の 【Excel VBA】Excelの置換リストでWord文書の文字列を一括置換 をベースに、置換対象を都度確認しながら実行するVBAのサンプル。
置換リストで一致したキーワードについて、都度、置換するかのメッセージを表示し、確認しながら置換を実行します。

「置換リストで都度確認しながらWord文書の文字列を置換」のVBAサンプル

サンプルは次のとおり。

Sub 置換リストで都度確認しながらWord文書の文字列を置換()

    Dim wrd As Object
    Set wrd = CreateObject("Word.Application")
    
    Dim 置換リスト As Variant
    Dim 最終行 As Long
    Dim 行 As Long
    Dim ファイル名 As Variant
    
'置換リストを2次元配列に変換'
    With Sheets("置換リスト")
        最終行 = .Cells(Rows.Count, 1).End(xlUp).Row
        置換リスト = .Range(.Cells(1, 1), .Cells(最終行, 2)).Value
    End With
  
'置換対象のWordファイルの取得'
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "置換対象のWordファイルを選択"
        .Filters.Clear
        .Filters.Add "Wordファイル", "*.docx"
    
        If .Show = -1 Then
            ファイル名 = .SelectedItems(1)
            .Filters.Clear
        Else
            .Filters.Clear
            Exit Sub
        End If
    End With

    Set wrd = wrd.Documents.Open(ファイル名)
    wrd.Application.Visible = True
    wrd.TrackRevisions = True '確認用で変更履歴をオン'
    Application.WindowState = xlMinimized 'Word表示のためExcelの最小化'
    wrd.Application.WindowState = xlMaximized
    AppActivate Application.Caption

'置換リストで都度確認しながら置換'
    With wrd.Application.Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchFuzzy = False
        .MatchWildcards = False
        .MatchCase = True
        .MatchByte = True
        .Forward = True
        
        For 行 = 2 To UBound(置換リスト)
            wrd.Range(0, 0).Select '検索を最初から実行のため'
            .Text = 置換リスト(行, 1)
            .Replacement.Text = 置換リスト(行, 2)
                      
            '検索と置換のループ'
            Do While .Execute
                Dim 回答 As VbMsgBoxResult
                
                回答 = MsgBox(置換リスト(行, 1) & "　を　" & 置換リスト(行, 2) & "　に置換しますか？" & Chr(13) & Chr(13) & "置換: [はい] / 次を検索: [いいえ]", vbQuestion + vbYesNoCancel)

                If 回答 = vbYes Then
                    wrd.Application.Selection.Collapse Direction:=1 '次で再検索するため、一旦Executeの実行前のカーソル位置に戻すため'
                   .Execute Replace:=1
                    wrd.Application.Selection.Collapse Direction:=0 '次の検索に備えてカーソル位置を設定'
                ElseIf 回答 = vbCancel Then
                    Exit Do
                End If
                                    
             Loop
        Next 行
        
        .ClearFormatting
        .Replacement.ClearFormatting
  End With
End Sub

補足説明

上記コードのベースは以下なので、基本の考え方は以下を参照。置換の都度確認が必要かどうかは目的次第ですが、変更履歴をオンにしているので、一括置換後のチェックでも良いと思う。

shikumika.org

以上、ExcelのVBAで、置換リストで一致したキーワードについて、都度、置換するかのメッセージを表示し、確認しながら置換を実行するサンプルでした。