PowerPoint ExportAsFixedFormatでPDF配布資料の作成 ppPrintOutputSixSlideHandoutsを指定してページあたり6枚のスライドでPDFを作成

概要:A列にある複数のパワーポイントファイルをPDF配布資料に一括変換する方法を紹介します
ページあたり6枚のスライドでPDFをマクロで作成してみた
VBAコードのテスト

キーワード:
#PowerPointVBA #パワーポイント #ExcelVBA #MSエクセル
#PDF変換 #一括変換 #フレーム付き #配布資料 #自動化

質問内容: 01:40

vbaでのパワーポイントの操作について質問です。
同じフォルダにある複数のパワーポイントをPDFファイルに変換したいです。
ExcelのA列に対象のパワーポイントのパスを列挙することはできます。
配布資料1ページあたり6枚のスライド、スライドはフレームで縁取りたいです。

実行結果: 02:49 の実行結果から見てください
https://www.youtube.com/watch?v=DwbEUtamCI8&t=169s

ヘルプを探すと
https://learn.microsoft.com/ja-jp/office/vba/api/powerpoint.presentation.exportasfixedformat
↑ココかな。

ExportAsFixedFormat (Path, FixedFormatType, Intent, FrameSlides, HandoutOrder, OutputType, PrintHiddenSlides, PrintRange, RangeType, SlideShowName, IncludeDocProperties, KeepIRMSettings, DocStructureTags, BitmapMissingFonts, UseISO19005_1, ExternalExporter)

↑なんだか、すごい数のパラメーターだけど・・・
例題のコードをコピーして、探っていきます

Public Sub ExportAsFixedFormat_Example() 
       ActivePresentation.ExportAsFixedFormat "C:\Users\username \Documents\test.pdf", ppFixedFormatTypePDF, ppFixedFormatIntentScreen, msoCTrue, ppPrintHandoutHorizontalFirst, ppPrintOutputBuildSlides, msoFalse, , , , False, False, False, False, False 
 
End Sub

FixedFormatType 10:08

ppFixedFormatTypePDF 2 PDF 形式にエクスポートします。

Intent

定数説明
ppFixedFormatIntentPrint オンラインで公開され、印刷されることを目的としています。
ppFixedFormatIntentScreen 既定値です。オンラインでのみ公開することを目的としています。

FrameSlides 10:46

定数説明
msoFalse 既定値です。エクスポートするスライドをフレームで縁取りません。
msoTrue エクスポートするスライドをフレームで縁取ります。

HandoutOrder 11:10

定数説明
ppPrintHandoutHorizontalFirst 連続するスライドがまず水平方向に (水平方向の行に) 表示されるように配布資料を印刷します。
ppPrintHandoutVerticalFirst 既定値です。連続するスライドがまず垂直方向に (垂直方向の列に) 表示されるように配布資料を印刷します。

OutputType 13:37

定数説明
ppPrintOutputBuildSlides
ppPrintOutputFourSlideHandouts 配布資料 1 ページあたり 4 枚のスライドを印刷します。
ppPrintOutputNineSlideHandouts 配布資料 1 ページあたり 9 枚のスライドを印刷します。
ppPrintOutputNotesPages ノートを印刷します。
ppPrintOutputOneSlideHandouts 配布資料 1 ページあたり 1 枚のスライドを印刷します。
ppPrintOutputOutline アウトラインビューを印刷します。
ppPrintOutputSixSlideHandouts 配布資料 1 ページあたり 6 枚のスライドを印刷します。
ppPrintOutputSlides プレゼンテーションのすべてのスライドを印刷します。既定値です。
ppPrintOutputThreeSlideHandouts 配布資料 1 ページあたり 3 枚のスライドを印刷します。
ppPrintOutputTwoSlideHandouts 配布資料 1 ページあたり 2 枚のスライドを印刷します。

05:58 ここから、私が作成したサンプルコードを説明する
https://www.youtube.com/watch?v=DwbEUtamCI8&t=358s
↑簡単な解説はここから。

ソースコード:ExcelからPowerPoint16.0を参照設定して使ってみてください。

'A列のフルパスPowerPointを開いて、配布資料PDF作成の処理を行う
Private Sub CommandButton1_Click()
    'PowerPointアプリの起動
    Dim ppApp As PowerPoint.Application
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True '可視にする
    DoEvents

    Dim y As Long  '行カウンタ
    y = 1    'A1から始めたいので
    
    Dim strPDFFileName As String   'PDFのファイル名
    
    'A列のファイル名が存在する間ループする
    While Len(Trim(Cells(y, "A"))) > 0
        '開く、コピー元を変数に入れる
        Dim ppプレゼン As 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") = "オープンエラー"
            DoEvents  'なぜか？固まって、動かない時がある・・
        Else
            Cells(y, "B") = ""  '開けたときは空白
            
            'PDFの出力先を作る、今回はexcelと同じ位置 ThisWorkbook.Pathに作成しました
            'Split(ppプレゼン.Name, ".")(0) ←手抜きの拡張子抜きの名前取得
            strPDFFileName = ThisWorkbook.Path & "\" & Split(ppプレゼン.Name, ".")(0) & ".pdf"
            Debug.Print "PDF出力先", strPDFFileName
            
            '開いたプレゼンをPDFの配布資料として出力する
            '単純に ExportAsFixedFormat を使っただけ
            ' https://learn.microsoft.com/ja-jp/office/vba/api/powerpoint.presentation.exportasfixedformat ←を見てください
            
            ppプレゼン.ExportAsFixedFormat strPDFFileName, _
                                            ppFixedFormatTypePDF, _
                                            ppFixedFormatIntentScreen, _
                                            msoTrue, _
                                            ppPrintHandoutVerticalFirst, _
                                            ppPrintOutputSixSlideHandouts
            
            DoEvents
            
            'PDF出力したので、開いたプレゼンは閉じる
            DoEvents
            ppプレゼン.Close
            DoEvents
            Set ppプレゼン = Nothing
        End If
        
        y = y + 1  '次の行へ※忘れて無限ループはシャレにならないよ・・・
    Wend
    
    ppApp.Quit
    Set ppApp = Nothing

    MsgBox "処理終了、PDFを確認してください"

End Sub

おまけ:ListViewでファイルを受け取る
ken3memo.hatenablog.com

'A列をクリア後、受け取ったファイル名を書き込む
'リストビューにファイルをドロップして、A列へ
' https://www.youtube.com/watch?v=Z9b5dXKVKzE
'紹介､宣伝兼ねて設置してみた､おいおい

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    
    Dim sFileName
    
    Columns("A:A").ClearContents  'A列のデータをクリアする
    
    Debug.Print "Data.GetFormat(1) =", Data.GetFormat(1)
    
    'テキストフォーマットで取得可能か聞く GetFormat(1) = Trueで判断
    If Data.GetFormat(1) = True Then
        '単純に書き出してみた
        Debug.Print "Data.GetData(1) =", Data.GetData(1)
        Range("a1") = "テキストデータを受け取りました。"
        Range("a2") = Data.GetData(1)
    Else
        'テキストで取得不可なら、ファイルでしょと考えるのは、安易だが、
        '(※他の、形式で、ドロップされたデータもあるので)

        'いつもの、.Countで数がわかるので、何かのチェックで使うか。
        Debug.Print "Data.Files.Count=", Data.Files.Count
        
        Dim nROW As Long  '行カウンタ
        nROW = 1   'A1から書き込むので初期値1を代入
        For Each sFileName In Data.Files  'ファイル名を取得
            Debug.Print "Data.Files = ", sFileName
            Cells(nROW, 1) = sFileName   'A列にファイル名をセットする
            nROW = nROW + 1  '次の行へ
        Next
        
    End If
    
End Sub

Private Sub Worksheet_Activate()
    Debug.Print "Worksheet_Activate", ActiveSheet.Name
    ListView1.OLEDropMode = ccOLEDropManual  'ドロップを受け入れる
End Sub