【VBA】パワーポイント内の文字列を置換する

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

スポンサーリンク

事前準備

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

テキストを置換する

指定したテキストを置換するためには、パワーポイントのプレゼンテーションオブジェクト以下の構造がどのようになっているのかをまず知る必要があります。置換したいテキストがどの要素に含まれるテキストかによってコードが変わってきますが、今回は一番単純なテキストボックス内の文字列を置換することを想定します。

まずは、オブジェクトの構造ですが、Presentationオブジェクト下にファイルを構成するSlideオブジェクトが存在します。このSlideオブジェクトがパワーポイントファイルの各ページを表していると考えてください。そして、このSlideオブジェクト下に書くページに含まれる要素の情報が格納されています。テキストボックスも含め、プレゼンテーションスライド内のオブジェクトはShapeオブジェクトとして保持されていますので、Slideオブジェクト下のShapeオブジェクトを取得してそのテキストを置換してやれば目的が達成できそうです。

当たり前のことですが、Presentationオブジェクトには複数のスライドが含まれ、また各Slideオブジェクトには複数のShapeオブジェクトが含まれます。すべてのテキストを検索して置換を行うには、すべてのSlideオブジェクトに含まれるすべてのShapeオブジェクトに対して置換を実行しなくてはなりません。

これだけでは終わりません。シェイプオブジェクトはグループ化されている場合があり、その場合はグループの各要素に対してテキストの置換を実行する必要があります。グループ化は入れ子になって何段階にもわたる可能性があるため、下記のサンプルコードでは再帰的に置換のための関数を呼び出して、グループ化されたオブジェクトがなくなるまで置換を実行するように書いてあります。

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

サンプルコード

Public Sub ReplaceTextText()
    
    '--- プレゼンテーションを開く ---'
    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 textTmp As String
    For Each slideObj In pptPrs.Slides
        
        For Each shapeObj In slideObj.Shapes
            
            Call replaceShapeText(shapeObj, orgStr, replacedStr)
            
        Next shapeObj
        
    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
スポンサーリンク