Excel VBA 簡単にPDFに出力する

窓のプログラム

家猫ミー

「Microsoft Print to PDF」という仮想プリンターが入っているので、調べたところ、Windows10から標準搭載のようです。

Windows10から搭載された「Microsoft Print to PDF」は、「プリンターとスキャナー」の中にある仮想プリンタードライバーである。プリンター名をクリックして「デバイスの削除」をクリックすると、「Microsoft Print to PDF」を削除することができる。Microsoftのアプリケーション（例：PowerPoint）を開き、印刷画面のメニュー内の「プリンター」をクリックし、「Microsoft Print to PDF」を選択することでPDFファイルを作成できる。また、「Ctrl」＋「P」キーを同時押しして印刷画面に飛び、「Microsoft Print to PDF」を選択し、「印刷」をクリックすることでもPDFファイルを作成できる。

とMicrosoft Bingはおっしゃっています。
外注の外注なので、あまり意識していませんでしたが、今頃になって「インボイス制度」対応かな。
というよりは、「電子帳簿保存法」改正に伴う対応か？ やたら急ぎでPDFがらみの案件が多くなりました。
「インボイス精度」は2023年10月から実施。
「電子帳簿保存法」は2024年1月より電子的なデータで受発注・請求支払処理が行われている場合「電子帳簿保存法を元に電子データで7年間保存してくださいね。」というものですね。
「インボイス精度」も「電子帳簿保存法」も少しあおりすぎですね、原稿のシステムでも十分対応可能です。
追加情報としては「適格請求書発行事業者」の登録番号項目を追加するだけですね。
また、発行・受領した帳票のバックアップの問題ですね。
それにしてもパッケージソフトと言い、Adobeと言い価格を上げているようです。
別にPDFにしなければいけないというわけではないのですが、ExcelやWordの文書もわざわざPDFで保存するような案件もありました。
少しおかしな方向に行っているのかもしれません。
これを契機に、組織のスリム化や在宅勤務にからめて、合理化の一環としてとらえようとしているところもあります。
そういうところは、元受けさんが頑張るので私のところまでは来ませんが
この制度の問題は帳簿・帳票の電子化にあるのではなく、その保存に有ります。
つまりデータのクラウド化やランサムウエアー対策が重要ということです。
また個人情報保護の観点からも、セキュリティー対策が問題になるのです。
と、ご説明するのですが、ユーザさんはPDFになればよいとお考えの様で、クラウド化にも乗り気ではないようです。
サーバもなく、7年間も問題なく保存できるのか疑問ではありますが、ご要望に沿って作業は進めています。
ちなみにクラウドのほとんどはファイルの修正・削除に対応しており数世代の変更及び削除は戻すことができます。
ランサムウエアで暗号化されても、データは元に戻せるのです。
データに対する保険と考えていただければよいのですが・・・・。
とはいえ、今回はPDFに出力する方法です。
前述した「Microsoft Print to PDF」を使えば簡単にPDF化できます。
その一般的な使い方ですが

Wordの例です。

印刷指定画面

ここで、「Microsoft Print to PDF」を選択して印刷するだけです。 印刷ボタンを押すと、PDFの保存場所を聞いてきますので、任意の場所を指定してください。

本題ですが、Excel VBAで同じようなことをする例を示します。
.NET系だとPDF出力は普通に行うので、ここでは省きます。

'印刷処理
Private Sub b一覧印刷_Click()
On Error GoTo Catch
    Dim sMsg As String
    'ワークシートの指定
    Dim Ws As Worksheet
    Set Ws = Sheets("科目List印刷")
    
    Ws.Visible = xlSheetVisible
    Ws.Unprotect PbPass
    
    'ワークシートのクリア
    sMsg = 出納DataCls(Ws)
    If sMsg <> "" Then
        Err.Raise 999, , sMsg
    End If
 
    '呼び出し元フォームを非表示にする
    Me.Hide
    f科目マスタ.Hide
    
    'ワークシートにデータを書き込む
    sMsg = 出納DataSet(Ws, Me)
    If sMsg <> "" Then
        Err.Raise 999, , sMsg
    End If
     
    '印刷処理終了時の画面操作
    Unload Me
    f科目マスタ.Show
    
    GoTo Finally
Catch:
    MsgBox Err.Description, , Me.Name
Finally:
    Ws.Protect PbPass
    Ws.Visible = xlSheetHidden
    Set Ws = Nothing
End Sub

Function 出納DataCls(ByRef Ws As Worksheet) As String
On Error GoTo Catch
    Dim rCnt As Integer
    Ws.Rows.Clear
Exit Function
Catch:
    出納DataCls = Err.Description
End Function

Function 出納DataSet(ByRef Ws As Worksheet, ByRef Uf As UserForm) As String
On Error GoTo Catch
    Dim uRow, uCol, dCnt, uPag As Integer
    Dim dfPrinter As String
    
    dCnt = 0
    For uPag = 0 To UBound(PbData, 1) * 2 - 1 Step 26
        With Ws
            '項目名の書き出し
            .Cells(uPag + 1, 1) = "科目No"
            .Cells(uPag + 1, 2) = "科目CD"
            .Cells(uPag + 1, 3) = "補助CD"
            .Cells(uPag + 1, 4) = "入出金区分"
            .Cells(uPag + 1, 5) = "入出金名"
            .Cells(uPag + 1, 6) = "科目名"
            .Cells(uPag + 1, 7) = "補助科目名"
            .Cells(uPag + 2, 1) = "会計報告区分"
            .Cells(uPag + 2, 2) = "会計報告名"
            .Cells(uPag + 2, 3) = "備考"
            '背景色を指定する
            .Range(.Cells(uPag + 1, 1), .Cells(uPag + 2, 7)).Interior.Color = XlRgbColor.rgbMintCream
            'Dataの書き出し
            For uRow = 3 To 26 Step 2
                .Cells(uPag + uRow, 1) = PbData(dCnt, 0)
                .Cells(uPag + uRow, 2) = PbData(dCnt, 1)
                .Cells(uPag + uRow, 3) = PbData(dCnt, 2)
                .Cells(uPag + uRow, 4) = PbData(dCnt, 3)
                .Cells(uPag + uRow, 5) = PbData(dCnt, 4)
                .Cells(uPag + uRow, 6) = PbData(dCnt, 5)
                .Cells(uPag + uRow, 7) = PbData(dCnt, 6)
                .Cells(uPag + uRow + 1, 1) = PbData(dCnt, 7)
                .Cells(uPag + uRow + 1, 2) = PbData(dCnt, 8)
                .Cells(uPag + uRow + 1, 3) = PbData(dCnt, 9)
                dCnt = dCnt + 1
                If dCnt > UBound(PbData, 1) Then
                    '最終行まで罫線を引く
                    .Range(.Cells(1, 1), .Cells(uPag + uRow + 1, 7)).CurrentRegion.Borders.LineStyle = True
                    Exit For
                Else
                    If dCnt Mod 2 = 0 Then
                        '1データおきに背景色を指定する
                        .Range(.Cells(uPag + uRow, 1), .Cells(uPag + uRow + 1, 7)).Interior.Color = XlRgbColor.rgbLemonChiffon
                    End If
                End If
            Next
        End With
    Next
    
    '====================================
    '   印刷設定を行う。
    '====================================
    'プリンター名を保存
    dfPrinter = Application.ActivePrinter
    If MsgBox("PDFに出力しますか？", vbYesNo) = vbYes Then
        'プリンターをPDF似変更
        Application.ActivePrinter = "Microsoft Print to PDF on Ne01:"
    End If
    '印刷設定 用紙A4
    Ws.PageSetup.PaperSize = xlPaperA4
    '印刷設定 用紙の向きを横にする
    Ws.PageSetup.Orientation = xlLandscape
    '印刷の実行 プレビュー画面を開く
    Ws.PrintOut Preview:=True
    '元のプリンターに戻す
    Application.ActivePrinter = dfPrinter
Exit Function
Catch:
    出納DataSet = Err.Description
End Function

ここでは印刷用のシートを用意しており、シートをクリアしてからデータをシートに書き出し、プレビューを表示してから印刷します。

わりと簡単にはできるのですが・・・・。

ちなみに、VBAで直接PDF出力も可能です。
その場合、プレビューは出せませんので、出力後表示させる形になります。

'書式は下記になります。
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
　　　　　　　　　　　　　　　　Filename:="フルパス\ファイル名.pdf", _
　　　　　　　　　　　　　　　　Quality:=xlQualityStandard, _
　　　　　　　　　　　　　　　　IncludeDocProperties:=True, _
　　　　　　　　　　　　　　　　IgnorePrintAreas:=False, _
　　　　　　　　　　　　　　　　OpenAfterPublish:=True

プリンターをいじらない分、安心感がありますね。

Ameba Blogの小技

画像の上に文字を配置するはこちらから

スマホ用のCSSを適用させるはこちらから

CSS 写真の角を丸めるはこちらから

CSS 横並びの表示するはここから

スキャンした画像を修正するはここから