【Access VBA】フォームからレポートを経由してPDF出力する

前回はフォームを使って予約の登録システムを作りました。

今回は登録した内容を各職員ごとの一覧にして配付するためのPDFに出力する機能を作ります。

スポンサーリンク

プログラムの流れ

PDFの元になるレポートを作成します。表示したいフィールドを配置します。

レポートフッターには件数を表示するため、コントロールソースを「=Count(*)」にしたテキストボックスを置きます。

ページ番号はメニューのレポートデザインからページ番号から設定できます。

レコードソース用に選択クエリを作成します。

フォームで使用していたようにコンボボックスを使えばIDから表示したい列を指定する方法も取れますが、レポートだとコンボボックスの表示がかっこ悪いのでテキストボックスで直接表示したいところ。そのためにクエリで値を取得します。

並べ替えの優先順位は、複数列に設定する場合は左にある列から優先となります。

フォームに「PDF出力」ボタンを作成します。出力したい年月と所属・職員を選択して押すことで先ほどのレポートを作成してPDF出力します。

実行後は、このAccessファイルがあるフォルダ上に「予約一覧出力フォルダ」を作成し、その中に表示期間を表した「yyyymmdd-yyyymmdd」というフォルダを作成、さらにその中に「氏名_yyyymmdd-yyyymmdd_予約一覧.pdf」を出力します。

PDFはこんな感じに出てきます。

所属、氏名、年月はフォームの入力から値を渡して表示させています。

VBA

レポート「R_予約一覧」読込時

Private Sub Report_Load()
    Dim avarOpenArgs As Variant
    avarOpenArgs = Split(Nz(Me.OpenArgs), ",")
    
    Me.tx氏名 = avarOpenArgs(0)
    Me.tx所属 = avarOpenArgs(1)
    Me.tx表示年 = avarOpenArgs(2)
    Me.tx表示月 = avarOpenArgs(3)
    
End Sub

レポートのヘッダーにある各種テキストボックスに表示する値です。オブジェクトの名称からどのテキストボックスかは判断してください。

avarOpenArgsの値は下記の「btnPDF出力」押下時のVBAで指定します。

「btnPDF出力」押下時

Private Sub btnPDF出力_Click()
    Const TARGET_REPORT As String = "R_予約一覧"
    Dim targetMemberID As Variant
    Dim targetMemberName As String
    Dim targetGroupID As Variant
    Dim targetGroupName As Variant
    Dim firstDate As Variant
    Dim lastDate As Variant
    Dim targetPeriod As String
    Dim filterCondition As String
    Dim strOpenArgs As String
    Dim saveFolder As String
    Dim Fso As Object
    
    If IsNull(Me.cmb職員) = True Then
        MsgBox "職員が選択されていません。"
        Exit Sub
    End If
    
    targetMemberID = Me.cmb職員
    targetMemberName = DLookup("氏名", "T_職員マスタ", "ID=" & targetMemberID & "")
    targetGroupID = Me.cmb所属
    targetGroupName = DLookup("所属", "T_所属マスタ", "ID=" & targetGroupID & "")
    firstDate = DateSerial(Me.tx表示年, Me.cmb表示月, 1)
    lastDate = DateAdd("d", -1, DateSerial(Me.tx表示年, Me.cmb表示月 + 1, 1))
    targetPeriod = Format(firstDate, "yyyymmdd") & "-" & Format(lastDate, "yyyymmdd")
    filterCondition = "日付 >= #" & firstDate & "# and 日付 <= #" & lastDate & "# and 職員ID = " & targetMemberID & ""
    strOpenArgs = targetMemberName & "," & targetGroupName & "," & Me.tx表示年 & "," & Me.cmb表示月
    saveFolder = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & "予約一覧出力フォルダ"
    
    'このAccessファイルがあるフォルダに「予約一覧出力フォルダ」があるか判定
    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Fso.FolderExists(saveFolder) = False Then 'フォルダがなければ作成
        MkDir saveFolder
    End If
    
    '「予約一覧出力フォルダ」内に期間ごとのフォルダがあるか判定
    saveFolder = saveFolder & "\" & targetPeriod
    If Fso.FolderExists(saveFolder) = False Then 'フォルダがなければ作成
        MkDir saveFolder
    End If
    
    DoCmd.OpenReport TARGET_REPORT, acViewPreview, , filterCondition, acHidden, strOpenArgs
    DoCmd.OutputTo acOutputReport, TARGET_REPORT, acFormatPDF, saveFolder & "\" & targetMemberName & " _" & targetPeriod & "_予約一覧.pdf"
    DoCmd.Close acReport, TARGET_REPORT
    
    MsgBox "PDF出力完了しました。"
    
End Sub

レポート読込時にavarOpenArgsに値を渡すために、所属と氏名をDLookup関数で取得し、表示する年月と一緒にカンマ区切りの文字列にしてstrOpenArgsに格納します。

そしてDoCmd.OpenReportの第5引数でstrOpenArgsを指定してレポートに渡します。

あとPDF出力が目的なのでレポートは開いてもすぐに閉じてしまいます。開く動作は見える必要がないので第4引数でacHiddenを指定しレポートを開く動作は表示しないようにします。

コメント

コメントする前にお読みください

プログラミングに関する質問について、詳細なコードはお答えしませんのでご了承ください。
また、迷惑コメント防止のために初回のコメント投稿は承認制です。投稿が反映されるまで少し時間がかかります。