PowerPoint VBA入門！ Shape.PickUp & Shape.Apply で複数スライドの書式を一括変更

PowerPoint VBAで複数スライドの書式を一括変更する方法

PowerPointで資料を作成する際、複数のスライドに同じ書式を設定したい場面はよくありますよね。しかし、手作業で一つずつ書式をコピー＆ペーストしていくのは、非常に面倒で時間がかかります。

そこで今回は、PowerPoint VBAを使って、この面倒な書式設定を自動化する方法を紹介します！ Shape.PickUp メソッドと Shape.Apply メソッドを組み合わせることで、複数のスライドにある同じ位置のシェイプに、一括で書式を適用することができます。

動画で解説

※作成した動画からAIでブログ記事を書いてもらった。

今回のブログの内容は、以下の動画でも解説しています。

ソースコード

1. 単体テスト: PickUp と Apply を使った書式コピー

Sub test0608書式コピーテスト001単体テスト()

    Dim ppShpMOTO As PowerPoint.Shape  'なんでも元、基準が必要だよね
    
    'テストコードなので、Slides(1)ページ目の"テキスト ボックス 3"を使用する
    Set ppShpMOTO = ActivePresentation.Slides(1).Shapes("テキスト ボックス 3")
    '↑スペースが含まれている名前が気になるけど、テストだからイッカ
    '自分でテスト、走らせるときに、注意してね
    
    '脱線したけど、単純に、.PickUp で 書式コピー
    ppShpMOTO.PickUp
    'ShapeからPickUp動作 ↑ピックアップ、選び取る？イメージだけど、書式のコピー

    'あとは、貼り付けるだけ Apply アプライ？英単語で調べると申し込み？アプラスとアコムは金貸しです。
    'スライドページ、2,3,4 の "テキスト ボックス 1"に
    '.Apply を指定して、適用(貼り付ける・・・)
    ActivePresentation.Slides(2).Shapes("テキスト ボックス 1").Apply
    ActivePresentation.Slides(3).Shapes("テキスト ボックス 1").Apply
    ActivePresentation.Slides(4).Shapes("テキスト ボックス 1").Apply

End Sub

2. 選択シェイプの判断 Selection.ShapeRange を使用

'あとは、応用で、選択されたShapeの書式をコピーする
Sub test0608書式コピーテスト002選択されたShapeの書式()

    If ActiveWindow.Selection.Type <> ppSelectionShapes Then  '種類の判断
        MsgBox "Shape図形やテキストボックスを選択してね", vbExclamation
        Exit Sub
    End If
    
    Dim ppShpMOTO As PowerPoint.Shape  'なんでも元、基準が必要だよね
    Set ppShpMOTO = ActiveWindow.Selection.ShapeRange(1)
    '↑選択された１件目のシェイプオブジェクトを代入
    
    '単純に、.PickUp で 書式コピー、ふと↑で、ShapeRange(1).PickUp？で良くない？と思ったり
    ppShpMOTO.PickUp
    'ShapeからPickUp動作 ↑ピックアップ、選び取る？イメージだけど、書式のコピー

    'あとは、貼り付けるだけ Apply アプライ？英単語で調べると申し込み？
    'スライドページ、2,3,4 の "テキスト ボックス 2"に
    '.Apply を指定して、適用(貼り付ける・・・)
    ActivePresentation.Slides(2).Shapes("テキスト ボックス 2").Apply
    ActivePresentation.Slides(3).Shapes("テキスト ボックス 2").Apply
    ActivePresentation.Slides(4).Shapes("テキスト ボックス 2").Apply

    MsgBox "終了、結果を確認してください"

End Sub

3. 結合テスト: 他のページ、同じ位置のシェイプに書式を適応させる

'同じ位置のシェイプの書式を合わせたい・・・
'選択されたシェイプの書式をコピーする
'各ページの 左上の座標 .Top , .Left が同じシェイプに貼り付ける
Sub test0608書式コピーテスト003同じ位置のシェイプ書式を合わせる()

    If ActiveWindow.Selection.Type <> ppSelectionShapes Then  '種類の判断
        MsgBox "Shape図形やテキストボックスを選択してね", vbExclamation
        Exit Sub
    End If
    
    Dim ppShpMOTO As PowerPoint.Shape  'なんでも元、基準が必要だよね
    Set ppShpMOTO = ActiveWindow.Selection.ShapeRange(1)
    '↑選択された１件目のシェイプオブジェクトを代入
    
    '単純に、.PickUp で 書式コピー、ふと↑で、ShapeRange(1).PickUp？で良くない？と思ったり
    ppShpMOTO.PickUp
    'ShapeからPickUp動作 ↑ピックアップ、選び取る？イメージだけど、書式のコピー

    'あとは、貼り付けるだけ Apply アプライ？英単語で調べると申し込み？
    'スライドの頭からループで回す
    Dim ppSlide As PowerPoint.Slide  'スライドのオブジェクト
    Dim ppShp   As PowerPoint.Shape  'シェイプのオブジェクト
    
    For Each ppSlide In ActivePresentation.Slides  '全スライドのループ
        For Each ppShp In ppSlide.Shapes  'スライド内の全シェイプのループ
            '左上の位置が同じなら処理する
            If ppShp.Top = ppShpMOTO.Top And ppShp.Left = ppShpMOTO.Left Then
                ppShp.Apply  '書式を貼り付ける
            End If
        Next
    Next
    '↑全てのシェイプをループで漁るので、ppShpMOTOの同じシェイプに貼り付けるけどOKかな。
    
    MsgBox "終了、結果を確認してください"

End Sub

ソースコードの説明

Shape.PickUp メソッドと Shape.Apply メソッド

PowerPoint VBAで書式をコピー＆ペーストするには、Shape.PickUp メソッド と Shape.Apply メソッド を使います。

• Shape.PickUp メソッド: 指定したシェイプの書式をコピーします
• Shape.Apply メソッド: PickUp メソッドでコピーした書式を、別のシェイプに適用します

この2つのメソッドは、セットで使用します。 00:30 Shape.PickUp メソッドと Shape.Apply メソッド から動画で確認できます。

1. 単体テスト PickUp Apply

このコードでは、スライド1にあるテキストボックス3の書式をコピーし、スライド2～4のテキストボックス1に適用します。 最初に、Shape 型の変数 ppShpMOTO を宣言し、書式をコピーする元のシェイプ（テキストボックス3）を代入します。 次に、 ppShpMOTO.PickUp で書式をコピーし、ActivePresentation.Slides(2).Shapes("テキスト ボックス 1").Apply などのコードで、各スライドのテキストボックス1に書式を適用します。 01:34 単体テスト PickUp Apply から動画で確認できます。

2. 選択シェイプの判断 Selection.ShapeRange を使用

このコードでは、選択したシェイプの書式をコピーし、スライド2～4のテキストボックス2に適用します。 ActiveWindow.Selection.ShapeRange(1) で、選択しているシェイプを取得し、Shape型の変数 ppShpMOTO に代入します。その後は、1.の単体テストと同様に、PickUp メソッドで書式をコピーし、 Apply メソッドで各スライドのテキストボックス2に適用します。 また、このコードでは、If ActiveWindow.Selection.Type <> ppSelectionShapes Then という条件分岐で、シェイプ以外のオブジェクト（例えば、表やグラフ）が選択された場合、メッセージボックスを表示して処理を終了するようにしています。 06:30 選択シェイプの判断 Selection.ShapeRange を使用 から動画で確認できます。

3. 結合テスト: 他のページ、同じ位置のシェイプに書式を適応させる

このコードでは、選択したシェイプの書式をコピーし、すべてのスライドにある同じ位置のシェイプに適用します。 2.のコードと同様に、Selection.ShapeRange(1) で選択したシェイプを取得し、PickUp メソッドで書式をコピーします。 その後、二重ループ処理で、すべてのアクティブなスライド (ActivePresentation.Slides) と、各スライド内のすべてのシェイプ (ppSlide.Shapes) を順番にチェックしていきます。 If ppShp.Top = ppShpMOTO.Top And ppShp.Left = ppShpMOTO.Left Then という条件分岐で、シェイプの左上の座標 (Top プロパティと Left プロパティ) が、最初に選択したシェイプと同じ場合は、Apply メソッドで書式を適用します。 09:52 結合テスト 他のページ、同じ位置のシェイプに書式を適応させる から動画で確認できます。

a) この動画で説明したこと、伝えたかった事

この動画では、PowerPoint VBAを使って、複数スライドにある同じ位置のシェイプに、一括で書式を適用する方法を解説しました。 Shape.PickUp メソッドと Shape.Apply メソッドを組み合わせることで、手作業で行っていた書式コピー＆ペーストの作業を自動化し、PowerPoint資料の作成効率を大幅に向上させることができます。

b) このソースコードで未解決の問題点、積み残しの課題

• シェイプの位置が完全に一致していないと、書式が適用されない
  • 今回のマクロでは、シェイプの左上の座標 (Top プロパティと Left プロパティ) の値が完全に一致するシェイプにしか書式が適用されませんでした。
  • 実際には、わずかに位置がずれている場合もあるため、判定条件を緩和する必要があるかもしれません。例えば、許容範囲を設定し、その範囲内のずれであれば書式を適用する、といった方法が考えられます。
• すべてのシェイプに対してループ処理を行うため、意図しないオブジェクトの書式まで変更されてしまう可能性がある
  • 特定の種類のシェイプ（例えば、テキストボックスのみ）に書式を適用したい場合は、シェイプの種類を判定する処理を追加する必要があります。

補足説明で紹介している関連性のあるリンク

• Shape.PickUp メソッド (PowerPoint): https://learn.microsoft.com/ja-jp/office/vba/api/powerpoint.shape.pickup
• Shape.Apply メソッド (PowerPoint): https://learn.microsoft.com/ja-jp/office/vba/api/powerpoint.shape.apply

---

敏腕編集者AIのおすすめ情報

• PowerPoint VBA 複数オブジェクト選択: 複数のオブジェクトを選択する方法を学ぶことで、より複雑な書式設定の一括変更が可能になります。
  • 参考リンク: https://www.sejuku.net/blog/95048
• PowerPoint VBA 図形サイズ変更: シェイプのサイズを一括変更する方法を学ぶことで、より柔軟な書式設定が可能になります。
  • 参考リンク: https://vbabeginner.net/powerpoint-vba-shapes-width-height/

PowerPoint VBAをマスターすれば、面倒な作業を自動化し、資料作成の時間を大幅に短縮することができます！ ぜひ、今回の解説を参考に、VBAスキルを磨いていきましょう！