[Microsoft Office]VBAでWordファイルの文章自動変換処理

前回まとめていた、[Microsoft Office]Word VBA (Excelも同じ) の続き

前提

• ワードファイルに変換処理を施したい文章が記載されている。
• エクセルファイルに、置換対象文字列と置換文字列が記載されている。
• wordのマクロ有効文書（docm）で処理している。（Excelのでもよかった）

実装例

Option Explicit

Sub findText()
    Dim xlsxName As String
    Dim wordName As String
    Dim myWord As Word.Document
    Dim countWord As Long
    Dim i As Long

    xlsxName = ThisDocument.Path & "\words.xlsx"
    wordName = ThisDocument.Path & "\target.docx"

    'wordファイルに変換したい文章が記載されている。
    'ファイルの存在を確認してからそれぞれオープン。
    If Dir(xlsxName) <> "" Or Dir(wordName) <> "" Then
        Workbooks.Open xlsxName
        Set myWord = GetObject(wordName)
        myWord.Application.Visible = True
        myWord.Activate
    Else
        MsgBox "ファイルが存在しません。", vbExclamation
        Return
    End If

    'excelファイルの2、3列目に置換対象文字列と置換文字列が記載されいている。
    'excelファイルは、シートは一つのみ、ヘッダが1行ある前提
    countWord = Range("A1").End(xlDown).Row
    For i = 2 To countWord
        Dim befWord As String
        Dim aftWord As String
        befWord = Cells(i, 2).Value
        aftWord = Cells(i, 3).Value
        '3列目（置換文字列）が空欄の場合は、括弧で強調する。
        If aftWord = "" Then
            aftWord = "<<" + befWord + ">>"
        End If
        'Debug.Print (befWord + " : " + aftWord)
        Call replaceWord(befWord, aftWord)
    Next i

    '最後に終了処理
    '変換したwordファイルは、保存してから終了する。
    Workbooks.Close
    myWord.Save
    myWord.Close

End Sub

Function replaceWord(beforeWord As String, afterWord As String)
    'Selection.FindをWordの先頭から実行する。
    ActiveDocument.Bookmarks("\StartOfDoc").Select
    With Selection.Find
        .Text = beforeWord
        .Execute Replace:=wdReplaceAll, replacewith:=afterWord
    End With
End Function