Word VBA/マクロ 備忘録

作業効率化のため作成したマクロをバックアップ代わりにアップしていきます。

【Word VBA/マクロ】文字列の置換(本文、オートシェイプ、ヘッダー・フッター・脚注)

サンプルコードでできること

本文・オートシェイプ(グループ化にも対応)・ヘッダー・フッター・脚注の文字列を一括置換します。

コードの説明

本文、ヘッダーフッター・脚注、オートシェイプの順にFindオブジェクトを用いて置換を行います。

検索の基本構文は次の記事を参照してください。
rapoppo.hatenadiary.jp

Set rng = ActiveDocument.Range(0, 0)

文章の冒頭にrngをセットするコードです。
このコードを使用した時点で、「あいまい検索」等の検索・置換条件は解除されるため、不要な条件の記述は不要です。
(Section.Findを用いる場合、すべての記述が必要)

mae = "※" '検索キーワード
ato = "*" '置換キーワード

必要に応じて、検索・置換キーワードを変更します。
書式を含める場合は「.Font」「.ParagraphFormat」を使用します。

Sub ReplaceKomeToAst()    
    Dim mae As String, ato As String
    Dim sec As Section, hdr As HeaderFooter, ftr As HeaderFooter
    Dim rng As Range, shp As Shape, gShp As Shape
    Dim ftNote As Footnote, endNote As endNote
    
    mae = "※" '検索キーワード
    ato = "*" '置換キーワード
    
    On Error Resume Next
    
    '本文置換
    Set rng = ActiveDocument.Range(0, 0)
    With rng.Find
        .Text = mae
        .Replacement.Text = ato
        .Execute Replace:=wdReplaceAll
    End With

    'ヘッダーフッター内置換
    For Each sec In ActiveDocument.Sections
        For Each hdr In sec.Headers
            With hdr.Range.Find
                .Text = mae
                .Replacement.Text = ato
                .Execute Replace:=wdReplaceAll
            End With
        Next
        
        For Each ftr In sec.Footers
            With ftr.Range.Find
                .Text = mae
                .Replacement.Text = ato
                .Execute Replace:=wdReplaceAll
            End With
        Next
    Next
    
    '脚注置換
    For Each ftNote In ActiveDocument.Footnotes
        With ftNote.Range.Find
            .Text = mae
            .Replacement.Text = ato
            .Execute Replace:=wdReplaceAll
        End With
    Next
    
    '文末脚注置換
    For Each endNote In ActiveDocument.Endnotes
        With endNote.Range.Find
            .Text = mae
            .Replacement.Text = ato
            .Execute Replace:=wdReplaceAll
        End With
    Next
    
    'オートシェイプ内置換
    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoGroup Then
           For Each gShp In shp.GroupItems
                If gShp.TextFrame.HasText Then
                    With gShp.TextFrame.TextRange.Find
                        .Text = mae
                        .Replacement.Text = ato
                        .Execute Replace:=wdReplaceAll
                    End With
                End If
            Next
        End If
        
        If shp.TextFrame.HasText Then
            Set rng = shp.TextFrame.TextRange
            With rng.Find
                .Text = mae
                .Replacement.Text = ato
                .Execute Replace:=wdReplaceAll
            End With
        End If
    Next
End Sub