VBAオジサンのらくがき帳

シートをPDFとして保存する

2021-04-02 00:00:00

※下の方法ではなくExportAsFixedFormatメソッドを利用したほうが簡単かもしれません。その方法についても今度まとめたいと思います。

エクセルのシートをPDFとして保存したいという場面もたまにあるではないかと思います。エクセルではプリンタの設定で「Microsoft Print to PDF」を使うことによりPDFとして印刷画面を出力することができますので、マクロでこれを実行すればPDFとして保存できます。

まずポート名を含めたプリンタの名前を取得するため、印刷画面でプリンタを選択した状態で、ApplicationオブジェクトのActivePrinterプロパティを確認します。

イミディエイトウィンドウで確認するのが簡単だと思います。

表示されたプリンター名をコードで設定して、WorksheetやWorkbookのPrintOutメソッドを使えばPDFとして出力することができます。

Application.ActivePrinter = "Microsoft Print to PDF on Ne01:"
'1つのシートをPDFとして保存
ActiveSheet.PrintOut , , , , , True, , "c:\output\sheet.pdf"
ActiveSheet.PrintOut PrintToFile:=True, PrToFileName:="c:\output\sheet.pdf"
'ブック全体をPDFとして保存
ThisWorkbook.PrintOut , , , , , True, , "c:\output\book.pdf"
ThisWorkbook.PrintOut PrintToFile:=True, PrToFileName:="c:\output\book.pdf"

PCの環境が変わるとプリンターのポート部分が変わってしまうことがありますので、下のようなプロシージャを使ってユーザがプリンターを変更できるようにすると安全かもしれません。

Function ChangeToPdfPrinter() As Boolean
    ChangeToPdfPrinter = False
    On Error Resume Next
    Application.ActivePrinter = "Microsoft Print to PDF on Ne01:"
    If Err.Number > 0 Then
        'プリンター設定ダイアログを開く
        If Not Application.Dialogs(xlDialogPrinterSetup).Show Then
            Exit Function 'キャンセルの場合終了
        End If
        'PDFライターが選択されたか確認
        If InStr(Application.ActivePrinter, "PDF") = 0 Then
            Exit Function
        End If
    End If
    ChangeToPdfPrinter = True
End Function

これを使ってシートを印刷するプロシージャを作ってみます。

Sub SaveSheetAsPdf(sheetName As String, fileName As String)
    If Not ChangeToPdfPrinter Then Exit Sub
    Sheets(sheetName).PrintOut , , , , , True, , fileName
End Sub

下のコードでSheet1をPDFとして保存できます。

SaveSheetAsPdf "Sheet1", "c:\output\sheet1.pdf"

複数のシートは下のようにすると一つのPDFとして保存できます。もしかしたらもっといい方法があるかもしれません。

Sub SaveSheetsAsPdf(sheetNames As Variant, fileName As String)
    Dim numOfShts As Long
    Dim sheetName As Variant
    Dim i As Long
    
    If Not IsArray(sheetNames) Then Exit Sub
    If Not ChangeToPdfPrinter Then Exit Sub
    Application.DisplayAlerts = False
    With Workbooks.Add '印刷用にブックを用意する
        numOfShts = .Sheets.Count '最初からあるシートの数
        For Each sheetName In sheetNames  '印刷用にブックにシートをコピー
            ThisWorkbook.Sheets(sheetName).Copy , .Sheets(.Sheets.Count)
        Next
        For i = 1 To numOfShts '最初からあるシートを削除
            .Sheets(1).Delete
        Next
        .PrintOut , , , , , True, , fileName
        .Close False '印刷用ブックは保存せずに閉じる
    End With
End Sub

下のコードで複数シートのPDF化ができます。

SaveSheetsAsPdf Array(""Sheet1"", ""Sheet2""), ""c:\output\sheets.pdf""