【VBA】スライドマスター内の文字列を置換する

エクセルVBAで使うコードの備忘録。VBAでパワーポイントファイルを操作して、スライドマスター内の指定した文字列を置換するコード。

スポンサーリンク

事前準備

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

スライドマスター内の文字列を置換する

各スライドに含まれるテキストボックスなどのシェイプオブジェクトの文字列を置換する方法はこちらでご紹介しましたが、この方法だけではスライドマスター内で保持されているオブジェクトの文字列は置換されません。スライドマスターのオブジェクトも置換するためには、Presentationオブジェクト内のMasterオブジェクト下にあるShapeオブジェクトにアクセスする必要があります。

それ以降の操作は同様で、Shapeオブジェクトの文字列を取り出して置換し、再度Shapeオブジェクトのテキストとして設定するだけです。同様に気を付けなければならないのは、Shapeオブジェクトがグループ化されている可能性を考慮することも必要です。

もう一つ、Master内のテキスト置換で気を付けなければならないのは、スライドマスターには複数のカスタムレイアウトが含まれる点です。上記のMasterオブジェクト下のShapeオブジェクトは、カスタムレイアウト全体に適用される、いわばマスターのマスターのようなデザイン内のShapeオブジェクトしか対象になりません。そのため、各カスタムレイアウト内に個別に追加されたShapeオブジェクトのテキストも置換するには、Masterオブジェクト下のCustomLayoutsオブジェクト内の個別要素に対してShapeオブジェクトの文字列置換を実行してやる必要があります。

下記のサンプルコードでは、MasterオブジェクトとMasterオブジェクト下のCustomLayoutsそれぞれのShapeオブジェクトに対して、置換するための関数を再帰的に呼び出し、グループ化されたShapeオブジェクトを含むすべてのShapeオブジェクトのTextを置換しています。

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

サンプルコード

Public Sub ReplaceMaster()
    
    '--- プレゼンテーションを開く ---'
    Dim pptObj As PowerPoint.Application
    Dim pptPrs As PowerPoint.Presentation
    Set pptObj = CreateObject("PowerPoint.Application")
    pptObj.Visible = True
    Set pptPrs = pptObj.Presentations.Open("[パワーポイントファイルのパス]")
    
    '--- 置換前の文字列 ---'
    Dim orgStr As String
    orgStr = "[置換前の文字列]"
    
    '--- 置換後の文字列 ---'
    Dim replacedStr As String
    replacedStr = "[置換後の文字列]"
    
    '--- 文字列を置換する ---'
    Dim slideObj As Slide
    Dim shapeObj As Variant
    Dim customLayoutObj As Variant
    Dim textTmp As String
    For Each slideObj In pptPrs.Slides
        
        '--- MasterのShapesを指定 ---'
        For Each shapeObj In slideObj.Master.Shapes
            
            Call replaceShapeText(shapeObj, orgStr, replacedStr)
            
        Next shapeObj
        
        '--- MasterのCustomLayoutsを指定 ---'
        For Each customLayoutObj In slideObj.Master.CustomLayouts
            
            For Each shapeObj In customLayoutObj.Shapes
            
                Call replaceShapeText(shapeObj, orgStr, replacedStr)
            
            Next shapeObj
            
        Next customLayoutObj
        
    Next slideObj
    
    '--- ファイルを閉じる ---'
    pptPrs.Close
    
End Sub

'--- ShapeオブジェクトのTextを置換する ---'
Private Sub replaceShapeText(shapeObj As Variant, orgStr As String, replacedStr As String)
    
    '--- グループの場合は再度各要素に対して置換を実行 ---'
    If (shapeObj.Type = msoGroup) Then
        
        Dim shapeTmp As Variant
        
        For Each shapeTmp In shapeObj.GroupItems
            
            Call replaceShapeText(shapeTmp, orgStr, replacedStr)
            
        Next shapeTmp
        
    Else
        Dim textTmp As String
        
        '--- テキストを取得 ---'
        textTmp = shapeObj.TextFrame.TextRange.Text
                
        '--- テキストを置換 ---'
        textTmp = Replace(textTmp, orgStr, replacedStr)
                
        '--- テキストを再度設定 ---'
        shapeObj.TextFrame.TextRange.Text = textTmp
        
    End If
    
End Sub
スポンサーリンク