【VBA】ワードファイル本文のシェイプオブジェクトの文字列を置換する

2019.03.28

エクセルVBAで使うコードの備忘録。VBAでワードファイルを操作して、シェイプオブジェクト内の文字列を置換するコード。

スポンサーリンク

事前準備

VBAでワードファイルを操作するには、参照設定が必要です。VBAのコードエディタから「ツール > 参照設定」と進み、「Microsoft Word XX.X Object Library」にチェックを入れておきます。

シェイプオブジェクトとは？

シェイプオブジェクトとは、ワードファイルに挿入された図形です。言葉で説明するよりも下記を見てもらった方がわかりやすいと思います。リボンの「挿入 > 図形」から選択して文書に差し込める図形のことを指します。

シェイプオブジェクトのテキストを置換する

シェイプオブジェクトのテキストを置換するには、文書内に含まれるすべてのシェイプオブジェクトを取得してそれぞれが持つテキストに対して置換作業をしてやればOKです。が、注意点はシェイプオブジェクトの中には

  1. 描画キャンパスとして複数のシェイプオブジェクトを内包しているもの
  2. グループ化されたシェイプオブジェクト

が存在するところです。

それぞれが一つのシェイプオブジェクトの中に複数のシェイプオブジェクトをもっているので、このようなタイプのシェイプオブジェクトを見つけた場合にはさらにその中を深く検索する必要があります。

下記のサンプルコードでは、描画キャンパスと通常のシェイプオブジェクトかどうかで場合分けをして処理をしています。また、シェイプオブジェクトであってもグループ化されている場合は再度その中の要素すべてに対してテキストの置換を行うようにしています。

なお、サンプルコードを使用する際はカッコに囲まれた部分（[***]）を自分のプログラムに合わせて変更してください。

サンプルコード

'--- 文書内のシェイプオブジェクトのテキストを置換する関数 ---'
Public Sub RepleceTextsInShapes()
    
    '--- Wordのアプリケーションオブジェクト ---'
    Dim objWord As Word.Application
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    
    '--- ドキュメントオブジェクト ---'
    Dim objDoc As Word.Document
    Set objDoc = objWord.Documents.Open("[ワードファイルのパス]")
    
    '--- 置換前の文字列 ---'
    Dim srcText As String
    srcText = "[置換前の文字列]"
    
    '--- 置換後の文字列 ---'
    Dim replaceText As String
    replaceText = "[置換後の文字列]"
    
    '--- 文書ないにあるすべてのシェイプオブジェクトに対してループ ---'
    Dim shp As Variant
    For Each shp In objDoc.Shapes
        
        '--- シェイプオブジェクトが描画キャンバスの場合 ---'
        If shp.Type = msoCanvas Then
            
            '--- 描画キャンパス内のすべてのアイテムに対してループ ---'
            Dim cvsShp As Variant
            For Each cvsShp In shp.CanvasItems
                
                '--- グループ化されている場合は再度ループ ---'
                If cvsShp.Type = msoGroup Then
                
                    Dim cvsGrpShp As Variant
                    For Each cvsGrpShp In cvsShp.GroupItems
                        Call ReplaceShapeText(cvsGrpShp, srcText, replaceText)
                    Next
                    
                Else
                    Call ReplaceShapeText(cvsShp, srcText, replaceText)
                End If
                
            Next
        
        '--- グループ化されている場合 ---'
        ElseIf shp.Type = msoGroup Then
            
            Dim grpShp As Variant
            For Each grpShp In shp.GroupItems
                Call ReplaceShapeText(grpShp, srcText, replaceText)
            Next
            
        '--- ただのシェイプオブジェクトの場合 ---'
        Else
            
            Call ReplaceShapeText(shp, srcText, replaceText)
            
        End If
        
    Next
    
    '--- ドキュメントを閉じる ---'
    objDoc.Close
    
    '--- ワードを閉じる ---'
    objWord.Quit
    
End Sub

'--- 引数として与えられたシェイプオブジェクトを置換する関数 ---'
Public Sub ReplaceShapeText(shp As Variant, srcText As String, replaceText As String)
    
    If shp.TextFrame.HasText Then
        Dim objFind As Find
        Set objFind = shp.TextFrame.TextRange.Find
        
        objFind.ClearFormatting
        objFind.Forward = True
        objFind.Text = srcText
        objFind.Replacement.Text = replaceText
        Call objFind.Execute(Replace:=wdReplaceAll)
        
    End If
End Sub
スポンサーリンク