【VBA】パワーポイント内のシェイプオブジェクトを調整する

エクセルVBAで使うコードの備忘録。VBAでパワーポイントファイルを操作して、スライド内のシェイプオブジェクトを調整するコード。

スポンサーリンク

事前準備

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

シェイプオブジェクトを調整する

下記のサンプルコードでは、指定したページに含まれるシェイプオブジェクトを取得して、そのサイズや位置、色などを変更しています。意図したシェイプオブジェクトを指定するのはなかなか難しい所ではありますが、私はシェイプオブジェクトのテキストに特殊なラベル（例えば「@Shape-01」みたいなもの）を付けておいて、そのテキストを持つシェイプオブジェクトを見つけたら操作を行うようにしています。

グループ化されているShapeオブジェクトを調整するときのため、関数を再帰的に呼び出してグループ内のすべての要素を探索するようにしてあります。

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

サンプルコード

Public Sub controlShapeObj()
    
    '--- プレゼンテーションを開く ---'
    Dim pptObj As PowerPoint.Application
    Dim pptPrs As PowerPoint.Presentation
    Set pptObj = CreateObject("PowerPoint.Application")
    pptObj.Visible = True
    Set pptPrs = pptObj.Presentations.Open("[パワーポイントファイルのパス]")
    
    '--- 操作するシェイプオブジェクトのテキスト ---'
    Dim shapeText As String
    shapeText = "[操作するオブジェクトのテキスト]"
    
    '--- 文字列を置換する ---'
    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 ctrlShape(shapeObj, shapeText)
            
        Next shapeObj
        
    Next slideObj
    
    '--- ファイルを閉じる ---'
    pptPrs.Close
    
End Sub

'--- ShapeオブジェクトのTextを置換する ---'
Private Sub ctrlShape(shapeObj As Variant, shapeText As String)
    
    '--- グループの場合は再度各要素に対して置換を実行 ---'
    If (shapeObj.Type = msoGroup) Then
        
        Dim shapeTmp As Variant
        
        For Each shapeTmp In shapeObj.GroupItems
            
            Call ctrlShape(shapeTmp, shapeText)
            
        Next shapeTmp
        
    Else
        Dim textTmp As String
        
        If (shapeObj.TextFrame.TextRange.Text = shapeText) Then
            
            '左端からの位置
            shapeObj.left = [左端からの位置]
            
            '上端からの位置
            shapeObj.top = [上端からの位置]
            
            'サイズ（高さ）
            shapeObj.Height = [高さ]
            
            'サイズ（幅）
            shapeObj.Width = [幅]
            
            '色
            shapeObj.Fill.ForeColor.RGB = [色コード RGB(255,255,255)みたいな感じ]
            
        End If
        
    End If
    
End Sub
スポンサーリンク