PowerPoint VBA スライドの削除 Presentation Slides Delete と Excel to PowerPointの差し込み印刷もどき処理

ActivePresentation.Slides(p).Delete でpページ目のスライドを削除することができます。
昨年作成した Excel to PowerPointの差し込み印刷もどき処理
ken3memo.hatenablog.com
↑で、
不具合・バグが発生していたので、その対策も兼ねて、
パワーポイントのスライドを削除してみました。処理の参考となれば幸いです。

youtu.be
https://youtu.be/OJLUpVB6cUA
目次
00:00 あいさつ・キッカケ
00:27 1.ExcelからPowerPointに差し込み印刷っぽくデータをセットするマクロ
02:16 2.質問をいただく
06:26 3.んっ？なんで、この削除質問があったんだろう？
08:16 4.運用で先にデータを削除する
10:00 削除コードの簡単な説明 .Slides(p).Delete
12:20 差し込みセット項目を増やしてテスト
13:54 再度データセットをしつこく解説する賞状を例題にする

#PowerPointVBA #パワーポイント #マクロ
#デバッグ #データ差し込み #差し込み印刷
#スライド削除

0.あいさつ・キッカケ
先頭、１ページ目だけ残し、
２ページ～最終ページまでを削除する。

※苦肉の策？で、１ページ目をひな型扱いにして、
　ExcelからPowerPointのスライドを複数作成する。

チョット、まとまっていませんが、
テスト動画作りをスタートする。

1.ExcelからPowerPointに差し込み印刷っぽくデータをセットするマクロ
昨年、
ExcelからPowerPointに差し込み印刷っぽくデータをセットするマクロ
を作成しました。

得意気に実演する。ぉぃぉぃ。

2.質問をいただく
下記の質問をいただく。

＞研修で使うスライドをこちらを参考に作ったところ、
＞すごく時短になりました。
＞ありがとうございます。
＞
＞そこで質問なんですが、
＞①一度パワーポイントにスライドを作った状態で、
＞エクセルを更新（データ追加、削除、追加など）した時、
＞自動でパワーポイントのデータも更新する方法はありますか？
＞
＞②パワーポイントの一枚目のスライドを残して、
＞それ以外のスライドを自動で削除する方法はありますか？

1.エクセルを更新（データ追加、削除、追加など）後に、
自動更新は、私も残念ながら、わかりません。
※表(セル)のリンク貼り付けで、１つ１つ、やれば可能かもしれませんが、
　あまり現実的ではないのかなぁ。

2.パワーポイントの一枚目のスライドを残して、
それ以外のスライドを自動で削除する方法はありますか？

はい、

    '2023/04/07 2p～最終ページまでを先に消す(※1ページ目を残す)
    For p = ppApp.ActivePresentation.Slides.Count To 2 Step -1
        ppApp.ActivePresentation.Slides(p).Delete
    Next p
    '↑最終ページ.Slides.Countから1ページ目までを後ろから削除する

↑、こんな感じで、
１ページ目だけを残し
他のページを削除することが可能になると思います。

3.んっ？なんで、この削除質問があったんだろう？
あっ、私のテスト、使い方の想定が甘い、バグですね・・・

バグの説明:

3.1 パワーポイントのひな型・テンプレートを作ります
3.2 ７人分のデータをテストで流し込み、やったねできたと思い込む
3.3 後日、再提出・督促分で３人、未提出を再出力する
3.4 あれれ、前回の分が残っていて、、、気が付かなかったらミスってたよ

4.先にデータを削除する
4.1 運用で対応する
　　仕様です。前回のデータを手で消して、１ページ目だけを残すと動きます。
　　そんな回避策を言ったら、怒られるな。
4.2 更新＝先に消してから新規追加すると、更新っぽく見える
あと、

＞①一度パワーポイントにスライドを作った状態で、
＞エクセルを更新（データ追加、削除、追加など）した時、
＞自動でパワーポイントのデータも更新する方法はありますか？

この作業だけど、データを全て消してから作ると、(※ひな型の1ページ目は残すけど)
更新されたっぼくなる。

こんな感じかなぁ。

5.終わりの挨拶
なんか、
テスト不足で　※先に消す処理が無くて
運用で、迷惑をかけたみたいで、すみません。

    '2023/04/07 2p～最終ページまでを先に消す(※1ページ目を残す)
    For p = ppApp.ActivePresentation.Slides.Count To 2 Step -1
        ppApp.ActivePresentation.Slides(p).Delete
    Next p
    '↑最終ページ.Slides.Countから1ページ目までを後ろから削除する

↑、こんな感じで、消してみてください。

業務、作業の参考となれば幸いです。　三流プログラマー Ken3

削除対応のソースコードは下記:
下記のソースを参考に組み込んで、使ってみてください。

'更新処理ができなかったので、
'パワポのスライドをひな型の先頭だけ残し、
'2～最終まで削除するバージョン
Sub Excelから起動済みのパワポにデータセット20230407()

    '起動済みのパワポを捕まえる
    Dim ppApp As Object
    
    Set ppApp = Nothing
    On Error Resume Next  'エラーが発生しても強引に次の命令に行け
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0  '忘れないで戻すぞ

    If ppApp Is Nothing Then
        MsgBox "セット用のパワポを開いてから、再テストしてね"
        Exit Sub
    End If
    
    'データをセットする
    Dim r As Range   'Excel 左上
    
    Set r = Range("A1")  'A1からテストで始める
    
    Dim p As Integer  'Excel側:行カウンタ pp:セットするページ
    Dim x As Integer  'Excel 列カウンタ、
    Dim str転記列名 As String  'Excel:転記列名 pp:セットするオブジェクト名
    Dim ppObjShape As Object 'ppセットするオブジェクト
    
    '2023/04/07 2p～最終ページまでを先に消す(※1ページ目を残す)
    For p = ppApp.ActivePresentation.Slides.Count To 2 Step -1
        ppApp.ActivePresentation.Slides(p).Delete
    Next p
    '↑最終ページ.Slides.Countから1ページ目までを後ろから削除する
    
    p = 1
    While Len(Trim("" & r.Offset(p, 0))) <> 0  '左端にデータがある間ループ
        'ppのセットページがなかったら、1ページを最終にコピー
        If p > ppApp.ActivePresentation.Slides.Count Then
            'スライドを増やす
            ppApp.ActivePresentation.Slides(1).Copy  '1ページ目をコピー
            ppApp.ActivePresentation.Slides.Paste p  '最終スライドpageに貼り付け
        End If
        
        'pページのスライドにデータをセットする
        For x = 0 To 99  '99までループにして途中でExitするループ
            str転記列名 = Trim("" & r.Offset(0, x)) '0行目のx列、項目名を取得
            If Len(str転記列名) = 0 Then Exit For '転記項目が無くなったら抜ける
            
            'Excelから単純にItem(項目名)でデータセット、エラーを無視して項目名無しを回避
            On Error Resume Next  'エラーが発生しても強引に次の命令に行け
            Set ppObjShape = Nothing  'これが無いと、前回オブジェクトが残る
            Set ppObjShape = ppApp.ActivePresentation.Slides(p).Shapes(str転記列名) 'セットするオブジェクト
            ppObjShape.TextFrame.TextRange.Text = r.Offset(p, x).Text 'Excelから文字列を代入
            On Error GoTo 0  '忘れないで戻すぞ
        Next x
        p = p + 1  '次の位置へ
    Wend

    MsgBox "セット終了"

End Sub

www.bing.com
で挿絵を作成してみました

動画の説明はチェックリストと辞令だけど、画像のイメージ作成で、

表彰状を受け取る男性
スーツ姿で立ち上がり、紙の表彰状を受け取りました

man receiving an award
I stood up in a suit and received a paper certificate of commendation.

バグ付きですが、昨年作成した動画:
詳しい、データ差し込みもどき処理の説明は、昨年の動画:
ExcelのデータをPowerPointに転記する Excelの項目名とPowerPoint同じ名前のオブジェクトにデータをセット自動転記マクロデバッグマクロ作り方・使い方
https://www.youtube.com/watch?v=-qPCSgPQuSw
を見てください。
ken3memo.hatenablog.com