エクセル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