前回はフォームを使って予約の登録システムを作りました。
今回は登録した内容を各職員ごとの一覧にして配付するための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の第５引数でstrOpenArgsを指定してレポートに渡します。
あとPDF出力が目的なのでレポートは開いてもすぐに閉じてしまいます。開く動作は見える必要がないので第４引数でacHiddenを指定しレポートを開く動作は表示しないようにします。
コメント