雑魚コンサルの個人的な備忘

エクセル大好き少年のメモ

【PPT】【VBA】よく使う操作:図形の特定/編集、スライドのコピーとか

PPTのマクロ個人的な基本。正直情報が少なくて効率的な処理方法とか全然わからないので、体系的に解説してくれてるところが欲しい。

大体マクロで同時処理する時って、下記のようなパターンが個人的には多い。

  1. コメント等の図形を全体から削除する。
  2. PPT範囲外に置いたフォーマット類を削除する。
  3. 定型ページの同位置のボックスにテキストを埋めこむ

ので、ここらへんの処理ができるようないろいろ

スライドの移動/選択(スライドのLoopと、スライドのアクティブ化)

PPTをマクロで処理する時、スライドがアクティブになっていないと止まる処理が多い。※具体的にはどの処理がひっかかるのか知らない

なので、大体下記処理を入れる。

Sub loopSlide()
  Dim lastSlide As Long
  Dim i As Long

  '最後のスライド番号を取得
  lastSlide = ActivePresentation.Slides.Count  
  'Loop
  For i = 1 To lastSlide
    ActiveWindow.View.GotoSlide i

    '///処理

  Next i
End Sub

スライドを複製していく

テンプレを作って、それをコピーしていくことが多いので、そのやり方。

Sub duplicateSlide()
  Dim newSldsCount As Long

  'スライド1を、PPTの最後のページに追加する
  With ActivePresentation
    newSldsCount = .Slides.Count + 1
    .Slides(1).Duplicate.MoveTo newSldsCount
  End With
  '複製したスライドに追加処理をする場合、アクティベートが必要
  ActiveWindow.View.GotoSlide newSldsCount
  'まあまあ重いので、PPTが落ちないようにしとくのもいいかも
  DoEvents
End Sub

オートシェイプの特定(位置情報/図形種類)

僕の場合は基本的には図形を特定する時、場所や図形種類で判断することが多い。
(この場所にある図形をXX、この種類の図形をXX、という処理)
その場合は、一旦図形を選択した状態で下記マクロを実行しておいて位置情報や種類を特定。

Sub getShpProperty()
  With ActiveWindow.Selection
    '位置情報
    Debug.Print .ShapeRange.Left
    Debug.Print .ShapeRange.Width
    Debug.Print .ShapeRange.Top
    Debug.Print .ShapeRange.Height
    'AutoShapeの種類(番号とか覚えられないので、一々取得して確認)
    Debug.Print .ShapeRange.AutoShapeType
  End With
End Sub

スライド内のオートシェイプに対するLoop処理(一般)

スライド内のすべてのオートシェイプを処理する場合は、Loopさせる
ただし、ここでちょっと難しいのがグループ化された図形は処理が特殊であること
※For~EachのLoopの中で、グループ化された図形はグループ単位で処理される

なので、基本的には下記のように再帰処理させることが多い

'本処理
Sub loopShapes
  Dim shp As Shape
  
  For i = 1 To lastSlide
    For Each shp In ActivePresentation.Slides(i).Shapes
      Call recursiveMacro(shp)
    Next shp
  Next i
End Sub

'再帰実行する処理
Sub recursiveMacro(shp As Shape)
  Dim shpRe As Shape
  'グループかされてるかどうかの判定。TypeがmsoGroupだとグループ化されている。
  If shp.Type = msoGroup Then
    'GroupItems(グループ内の図形)それぞれに再帰実行
    For Each shpRe In shp.GroupItems
      Call recursiveMacro(shpRe As Shape)
    Next shpRe
  'グループ化されてない図形だったら本処理
  Else
    '///処理
  End If
End Sub

オートシェイプに対する処理:特定の図形をまとめてコピーする

テンプレを作って、それをコピーしていくことが多いので、そのやり方。

Sub copyShapes()
  Dim shp As Shape

  'スライド1にテンプレがあるとして、それをコピーしていくパターン
  For Each shp In ActivePresentation.Slides(1).Shapes
    '条件判定により、図形を順次選択。この場合は、スライド枠外左にある図形を選択
    '必要に応じて、上記のGroupへの再帰処理も組み込む
    If shp.Left < 0 Then
        shp.Select Replace:=msoFalse
    End If
  Next shp
  'コピー:何も選択されていない場合たぶんエラーになるので、回避
  If ActiveWindow.Selection.Type <> ppSelectionNone Then
    ActiveWindow.Selection.Copy
  End If

  '参考:ペースト
  ActivePresentation.Slides(1).Shapes.Paste
  '参考:ペースト
  ActiveWindow.Selection.Delete

End Sub