AccessのレポートをPDF出力して既定のPDFビューワで開くコード

はじめに

Accessのレポートを、不特定多数のPCで同じように印刷できるようにするのって結構めんどくさいですよね。プリンタ設定が端末ごとにばらばらだったり。

めんどくさい部分はそれが得意なツールに任せてしまおう、ということで印刷部分はPDFビューワに丸投げしてみました。

標準モジュールを適当な名前で新規作成して以下のコードを貼り付けて[DoCmd.OpenReport]の代わりに呼んでください。

どこかの誰かが同じ悩みを持っていたりしないかな、と、初投稿。先輩方のご指導ご鞭撻よろしくお願いします。

コード

chatGPTさんに結構手伝ってもらいました。

'
'  渡されたフォームをPDFへ出力し既定のPDFビューワーで開く
'
'　　呼出し例
' Call OutputPdf("YourReportName", "FilterName（省略可能）", "Condition（省略可能）", Papersize, Orientation)
'
' Call OutputPdf("YourReportName", , , 12, 2) ' B4用紙の横向き
' Call OutputPdf("EmployeeReport", "ActiveEmployees", "[Status] = 'Active'", acPRPSA4, acPRORPortrait)  ' A4用紙の縦向きでフィルターを適用
'
Option Compare Database
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long

Function GetEnvVariable(ByVal VarName As String) As String
    Dim buffer As String
    Dim length As Long
    
    buffer = String$(255, vbNullChar)
    length = GetEnvironmentVariable(VarName, buffer, Len(buffer))
    
    If length > 0 Then
        GetEnvVariable = Left$(buffer, length)
    Else
        GetEnvVariable = ""
    End If
End Function

Function IsReportLoaded(ReportName As String) As Boolean
    Dim obj As AccessObject
    Set obj = CurrentProject.AllReports(ReportName)
    IsReportLoaded = obj.IsLoaded
End Function

Function OutputPdf(ByVal ReportName As String, Optional ByVal FilterName As String = "", Optional ByVal WhereCondition As String = "", Optional ByVal PaperSize As Long, Optional ByVal Orientation As Long)
    On Error GoTo ErrorHandler

    Dim RepNAME As String
    Dim pdfPath As String
    Dim tempDir As String

    RepNAME = ReportName
    
    ' 環境変数から出力ディレクトリを取得
    tempDir = GetEnvVariable("TMP")
    
    ' 環境変数が取得できない場合、デフォルトでC:\TEMPを使用
    If tempDir = "" Then
        tempDir = "C:\TEMP"
    End If
    
    pdfPath = tempDir & "\" & RepNAME & ".pdf"
    
    ' レポートをプレビューで開く
    DoCmd.OpenReport RepNAME, acViewPreview, FilterName, WhereCondition, acHidden
    
    ' レポートが開かれるのを待つ
    Do While Not IsReportLoaded(RepNAME)
        DoEvents
    Loop
    
    ' 用紙サイズと向きを設定
    Reports(RepNAME).Printer.PaperSize = PaperSize
    Reports(RepNAME).Printer.Orientation = Orientation
    
    ' PDFへ書き出し
    DoCmd.OutputTo acOutputReport, RepNAME, acFormatPDF, pdfPath
    
    ' プレビューで開いているレポートを閉じる
    DoCmd.Close acReport, RepNAME

    ' PDFを開く
    ShellExecute 0, "open", pdfPath, vbNullString, vbNullString, vbNormalFocus

    Exit Function

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    ' 必要に応じてエラーログに記録するコードを追加できます。
    ' 例: LogError Err.Number, Err.Description
End Function