三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。

よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

パワポの複数スライドをExcelマクロを使用して1つにする ExcelのA列に入力したファイル名リストを使用してPowerPointのスライドを合体させる

複数のパワポ.pptxファイルを1つのファイルにまとめたい。

A列に複数のファイル名 この複数パワポを一つにまとめる

Excelマクロを使用して、
A列に入力したPowerPointファイルを開き、一つにまとめてみました。
実験動画です。コードをアレンジして使ってみてください。
#PowerPointVBA #ExcelVBA
youtu.be
https://youtu.be/7Uw9u3CbmHY
目次
00:00 0.やりたいこと
00:28 1.簡単な仕様を考えてみます。
01:42 2.単体テスト まずは、A1のファイルを開いてみます
04:36 3.複数スライド1,2ページを新規プレゼンファイルにコピー
05:43 新規のプレゼン作成とタイトルセットを説明
07:11 A列のファイルを開いてスライド1,2をコピー貼り付け
09:37 実行時エラー 497 リートサーバーがないか~ DoEventsを入れて回避する
11:56 複数ファイルで実行
14:15 4.勝手に脱線 全てのスライドページをコピペするには?応用編?
15:36 テストデータを更新して スライドまとめの再チェック
18:13 5.課題・問題点 A列にファイル名を記入する順番について
18:46 蛇足で宣伝 前回の動画 Excel VBA ListView を紹介
21:59 バグに気が付く 1Pageしかない時に1,2をコピーした時・・・

0.やりたいこと
PowerPointのファイルを一つにまとめたい

いつもの(ぉぃぉぃ)知恵袋の質問に触発され、
detail.chiebukuro.yahoo.co.jp

PowerPointのファイルを一つにまとめるソフトはありますか?
PowerPointのファイルが50個あります
>ファイル一つにつき2枚のスライドがあり、
>このスライド100枚を一つのPowerPointのファイルにまとめたいです。
>一つ一つのファイルをコピペしていたら時間がかかりすぎるので、一気にまとめる方法を探しています。
>こうした理由で、複数のPowerPointのファイルの内容を
>一つのPowerPointにまとめるソフトがないかご存じのかた、ご教示ください!

探せば、いくらでもあるのに、
パワーポイント初心者・素人プログラマーがツールもどきの作成を勝手に始めました。

1.簡単な仕様を考えてみます。

入力:PowerPointのファイルが50個
出力(結果):1つのファイルにまとまったPowerPointファイル

ここから、まずは、
そのPowerPointのファイルが50個がどこにあるか?
お客様じゃなかった、質問者にヒアリングしないといけないんだけど、
勝手に、作り始めます。

視聴者の声:※違う方向に行って、失敗する未来が見えた・・・

リスト管理と言えばExcelなので、
A列に50個のファイル名 フルパスを記入して、
A列
D:\2023\資料001.pptx
D:\2023\資料002.pptx

それを一つにまとめてみます。

視聴者の声:
※※だからぁ、まとめるファイルが指定フォルダーに50個全て入っていて、
フォルダー指定かもしれないでしょ、仕様を詰めないとだめだよ・・・
勝手に進めちゃって・・・

2.単体テスト まずは、A1のファイルを開いてみます

手前みそ紹介
ExcelからPowerPointを開き データセット後 別名保存する 差し込み印刷っぽいデータ流し込み マクロの作り方
https://youtu.be/mof40MhZrYw?t=653
を参考にして、

Sub test001_セルA1のPowerPointファイルを開く()

    'PowerPointアプリの起動
    Dim ppApp As Object   'PowerPoint.Application 
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True '可視にする

    'いつもActivePresentationでやってるけど、たまには変数を使用
    Dim ppプレゼン As PowerPoint.Presentation  'pp:プレゼンテーション
    Set ppプレゼン = Nothing '初期化、エラーチェックもかねて
    On Error Resume Next   '↓でSet 取得エラー時に次へ ファイルが開けなかった時
    Set ppプレゼン = ppApp.Presentations.Open(Range("A1")) 'A1のファイル名を開く
    On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
    '↑単純に、.Open "ファイル名" で開いただけです
    If ppプレゼン Is Nothing Then
        MsgBox "Err A1パワポのファイル名、パスを確認してください", vbExclamation
        Exit Sub
    End If

    MsgBox "終了、無事に開けたか?確認してください"

End Sub

3.複数スライド1,2ページを新規プレゼンファイルにコピー

次は、スライドのコピー
これも、過去動画で何かないかなぁ・・・
PowerPoint VBA 複数スライドのコピー 例題:Excel A~C,D~Fをパワポにスライド2枚単位でデータを流し込む
https://www.youtube.com/watch?v=-GVsj_kYbMI&t=172s

'2.2 ↑ひな型の1,2ページスライドをコピーする
'Slides.Range(Array( 番号or名前で複数指定
oPPひな型.Slides.Range(Array(1, 2)).Copy
'↑1と2のスライドをコピーする

.Slides.Range(Array(1, 2)).Copy
↑おっ、2ページ固定コピー、そのままありますね。

'2.3 Excelの行数分 テンプレのスライドをコピーする
'新規のプレゼンを追加して、↑でコピーしたスライドを貼り付ける
oApp.Presentations.Add '新規追加
'テンプレートスライドを増やす
oApp.ActivePresentation.Slides.Paste 'ひな型を新プレゼンに貼り付け


.Slides.Paste で貼りつくみたいだけど、
貼り付け位置を最終、最後のページに追記したいなぁ。

で、単体テストをしてみます。

'test002_セルA列のプレゼンを開き1p2pをコピペ
Private Sub CommandButton2_Click()
    
    'PowerPointアプリの起動
    Dim ppApp As Object   'PowerPoint.Application
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True '可視にする
    DoEvents

    '新規の枠、新規プレゼンの作成
    Dim pp新規 As Object  'As PowerPoint.Presentation
    Set pp新規 = ppApp.Presentations.Add(WithWindow:=msoTrue) '新規追加
    'スライドの追加 レイアウトの種類 Layout:=ppLayoutTitleOnly  11
    Call pp新規.Slides.Add(Index:=1, Layout:=11)
    'タイトルをセット 一番目のオブジェクトにテキストセット
    pp新規.Slides(1).Shapes(1).TextFrame.TextRange.Text = "スライドまとめ"
    DoEvents
    
    Dim y As Long  '行カウンタ
    y = 1    'A1から始めたいので
    
    'A列のファイル名が存在する間ループする
    While Len(Trim(Cells(y, "A"))) > 0
        '開く、コピー元を変数に入れる
        Dim ppプレゼン As Object  'PowerPoint.Presentation  'pp:プレゼンテーション
        Set ppプレゼン = Nothing '初期化、エラーチェックもかねて
        On Error Resume Next   '↓でSet 取得エラー時に次へ ファイルが開けなかった時
        Set ppプレゼン = ppApp.Presentations.Open(Trim(Cells(y, "A"))) 'A列のファイル名を開く
        DoEvents
        On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
        '↑単純に、.Open "ファイル名" で開いただけです
        If ppプレゼン Is Nothing Then '↑上で開けたか?
            'openエラーの時、B列に開けなかったことを知らせる
            Cells(y, "B") = "オープンエラー"
        Else
            Cells(y, "B") = ""  '開けたときは空白
            '開いたプレゼンの1,2ページを固定でコピーする
            'Slides.Range(Array( 番号or名前で複数指定
            ppプレゼン.Slides.Range(Array(1, 2)).Copy
            DoEvents
            '↑1と2のスライドをコピーする
            
            '新規に貼り付ける。合体させる?
            pp新規.Slides.Paste   'ひな型を新プレゼンの最後に追加貼り付け
            DoEvents
            
            '貼り付けたので、開いたプレゼンは閉じる
            ppプレゼン.Close
            DoEvents
            Set ppプレゼン = Nothing
        End If
        
        y = y + 1  '次の行へ※忘れて無限ループはシャレにならないよ・・・
    Wend
    
    MsgBox "処理終了、パワポを確認してください"

End Sub


4.勝手に脱線 全てのスライドページをコピペするには?応用編?

'Slides.Range(Array( 番号or名前で複数指定
ppプレゼン.Slides.Range(Array(1, 2)).Copy
'↑1と2のスライドをコピーする

で、1と2ページを指定してコピーしています。

質問には、書いてないけど、
全てのページをコピーするには、
ActivePresentation.Slides.Range.Copy
と、
Slides.Range(ここを指定しない)
Slides.Range.Copy
で全てコピーされます。

'test003_セルA列のプレゼンを開き全てのスライドをコピペ
Private Sub CommandButton3_Click()

    'PowerPointアプリの起動
    Dim ppApp As Object   'PowerPoint.Application
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True '可視にする
    DoEvents

    '新規の枠、新規プレゼンの作成
    Dim pp新規 As Object  'As PowerPoint.Presentation
    Set pp新規 = ppApp.Presentations.Add(WithWindow:=msoTrue) '新規追加
    'スライドの追加 レイアウトの種類 Layout:=ppLayoutTitleOnly  11
    Call pp新規.Slides.Add(Index:=1, Layout:=11)
    'タイトルをセット 一番目のオブジェクトにテキストセット
    pp新規.Slides(1).Shapes(1).TextFrame.TextRange.Text = "スライドまとめ"
    DoEvents

    Dim y As Long  '行カウンタ
    y = 1    'A1から始めたいので
    
    'A列のファイル名が存在する間ループする
    While Len(Trim(Cells(y, "A"))) > 0
        '開く、コピー元を変数に入れる
        Dim ppプレゼン As Object  'PowerPoint.Presentation  'pp:プレゼンテーション
        Set ppプレゼン = Nothing '初期化、エラーチェックもかねて
        On Error Resume Next   '↓でSet 取得エラー時に次へ ファイルが開けなかった時
        Set ppプレゼン = ppApp.Presentations.Open(Trim(Cells(y, "A"))) 'A列のファイル名を開く
        DoEvents
        On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
        '↑単純に、.Open "ファイル名" で開いただけです
        If ppプレゼン Is Nothing Then '↑上で開けたか?
            'openエラーの時、B列に開けなかったことを知らせる
            Cells(y, "B") = "オープンエラー"
        Else
            Cells(y, "B") = ""  '開けたときは空白
            '開いたプレゼン
            'Slides.Range.Copy で 全てのスライドをコピー
            ppプレゼン.Slides.Range.Copy
            DoEvents
            '↑スライドをコピーする
            
            '新規に貼り付ける。合体させる?
            pp新規.Slides.Paste   'ひな型を新プレゼンの最後に追加貼り付け
            DoEvents
            
            '貼り付けたので、開いたプレゼンは閉じる
            ppプレゼン.Close
            DoEvents
            Set ppプレゼン = Nothing
            DoEvents
        End If
        
        y = y + 1  '次の行へ※忘れて無限ループはシャレにならないよ・・・
    Wend
    
    MsgBox "処理終了、パワポを確認してください"

End Sub

5.課題・問題点 A列にファイル名を記入する順番について

話は、冒頭に戻ってしまいますが、

入力:PowerPointのファイルが50個
出力(結果):1つのファイルにまとまったPowerPointファイル

連番なら、おっさんがテストでやったみたいに、
ドラッグで連番にすればいいけど、

そのPowerPointのファイルが50個がどこにあるか?
お客様じゃなかった、質問者にヒアリングしないと

視聴者の声:※違う方向に行って、失敗する未来が見えた・・・

視聴者の声:
※※だからぁ、まとめるファイルが指定フォルダーに50個全て入っていて、
フォルダー指定かもしれないでしょ、仕様を詰めないとだめだよ・・・
勝手に進めちゃって・・・

と、
課題や問題点を残しつつ、
実験コードをアレンジして使えるとイイなぁ・・と思いつつ・願いつつ、
逃げるように失礼します。。。。




蛇足で宣伝?
前回の動画
Excel VBA ListView の設置方法 OLEDragDropを使ってみた
https://www.youtube.com/watch?v=Z9b5dXKVKzE

ListViewを使用して、
ファイルエクスプローラからドロップしたファイル
A列にファイル名を書き出す
これを使ってみてください。

視聴者の声:それよりも、王道の
ファイルダイアログ(FileDialog)
をネットで検索するからいいよ。

フォルダーなら
Application.FileDialog(msoFileDialogFolderPicker)

ファイルなら
Application.FileDialog(msoFileDialogOpen)
Filters.Add "PowerPoint", "*.pptx"
みたいに使うから・・・

ですよねぇ。

以上、蛇足宣伝でした。



関連する過去記事:
ken3memo.hatenablog.com
ken3memo.hatenablog.com


複数のファイル・書類を一つの書類にまとめる作業を行う一人の男性の姿をイラストで描いてください。
Please illustrate one man working on consolidating multiple files/documents into one document.

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。

  1. [VBA・マクロ プログラミング]の解説
    当店の人気はVBA系のCreateObject("XXXXXX.application")で他のアプリケーションを操作するサンプルが人気です
  2. [プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
    三流君を踏み台にする
  3. [古いクラシック ASP(Active Server Pages)]の解説。
  4. [元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)