【Excel VBA】指定フォルダ内のWord文書を置換リストで一括置換するサンプル

ExcelのVBAで、指定フォルダ内に保存したWord文書（複数）をExcelの置換リストで一括置換するサンプルです。

複数のWord文書について、置換リストで一致した対象の置換可否をメッセージで都度確認し、置換を実行します。

内容：

VBAの前提
VBAサンプル
VBAの補足説明

VBAの前提

複数のWord文書ではなく、単独ファイルでのマクロは次のとおりです。

VBAサンプル

VBAのサンプルは次のとおりです。

Option Explicit
Dim 置換リスト As Variant
Dim wrdApp As Object
Dim wrdDoc As Object


Sub 指定フォルダ内のWord文書を置換リストで一括置換()
    
    Dim 最終行 As Long
    Dim 指定フォルダ名 As String

'置換リスト (文章)を2次元配列に変換’
    With ThisWorkbook.Sheets("置換リスト (文章)")
        最終行 = .Cells(Rows.Count, 1).End(xlUp).Row
        置換リスト = .Range(.Cells(1, 1), .Cells(最終行, 2)).Value
    End With

'指定フォルダ名を取得'
    指定フォルダ名 = ThisWorkbook.Sheets("設定シート").Range("D9").Value ' Onedrive同期フォルダのため設定値をシートに記載で対応'
    
'フォルダ内の各ファイルの処理'
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    Dim 指定フォルダ As Object
    Set 指定フォルダ = fs.GetFolder(指定フォルダ名)

    Dim 対象ファイル As Object
    For Each 対象ファイル In 指定フォルダ.Files ' フォルダ内のファイルを取得
        If InStr(対象ファイル.Name, ".docx") > 0 Then
            Call 都度確認しながら置換リストでWord文書の文字列を置換(対象ファイル.Path)
        End If
    Next

'終了処理'
    Set fs = Nothing

End Sub


Function 都度確認しながら置換リストでWord文書の文字列を置換(ファイル名 As String)

    Set wrdApp = CreateObject("Word.Application")

' Word文書を開く'
    Set wrdDoc = wrdApp.Documents.Open(ファイル名)
    wrdApp.Visible = True
    wrdDoc.TrackRevisions = True '確認用で変更履歴をオン'
    Call ExcelとWordの画面を分割にする(wrdApp, Application)

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

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

    '終了処理'
    wrdDoc.Close SaveChanges:=True
    wrdApp.Quit
    Application.WindowState = xlMaximized

    Set wrdDoc = Nothing
    Set wrdApp = Nothing
  
End Function

Function ExcelとWordの画面を分割にする(左画面 As Object, 右画面 As Object)
    ' 画面の幅と高さを取得'
    Dim screenWidth As Long
    Dim screenHeight As Long
    
    Application.WindowState = xlMaximized
    screenWidth = Application.Width
    screenHeight = Application.Height

    With 左画面
        .WindowState = xlNormal
        .Top = 0
        .left = 0
        .Width = screenWidth / 2
        .Height = screenHeight
    End With
    
    With 右画面
        .WindowState = xlNormal
        .Top = 0
        .left = screenWidth / 2
        .Width = screenWidth / 2
        .Height = screenHeight
    End With
        
End Function

VBAの補足説明

上記コードで、
'指定フォルダ名を取得' 指定フォルダ名 = ThisWorkbook.Sheets("設定シート").Range("D9").Value ' Onedrive同期フォルダのため設定値をシートに記載で対応'
の箇所は、目的に応じて指定フォルダを指定する内容に修正します。
この処理をしている背景の一つに以下があります。

shikumika.org
「ExcelとWordの画面を分割」については、以下の処理の具体例です。

shikumika.org

以上、Excel VBAを利用し、指定フォルダ内のWord文書を置換リストで一括置換するサンプルでした。