【Access VBA】登録＆検索用フォームを作成する

前回はユニオンクエリのことを取り上げました。今回はその続きです。というかこの記事のための準備に過ぎませんでした。

予約台帳っぽいものを作って、フォームから登録と検索をできるしくみを作ります。

完成サンプル
準備するテーブル、クエリ、フォーム
VBA

完成サンプル

とりあえずこんな感じのものを作るよっていうサンプルをば。

何の予約かは特に決めていないのですが、とりあえず予約フォームです。

日付と開始・終了時間、所属、職員、備考を登録するものです。このフォームは登録用と検索用を兼ねています。

使い方は各フィールドに入力して、新規に登録する時は「登録」、既存のレコードを表示させる場合は「検索」を押します。

「登録」をクリックすると登録したレコードを含む、その日付のレコードが表示されます。

職員のコンボボックスは、選択された所属によって所属している職員のみに絞り込まれます。

なお、前回の記事で異動などにより期間で所属が異なる想定で作ってまして、日付の入力に応じて該当する期間内の所属で表示されるようにしています。

あと検索の方法について、月で絞り込みたい場合と日で絞り込みたい場合があるので、「検索期間」のオプションボタンで切り替えられるようにしています。「月」にすれば上の年月から、「日」にすれば「日付」の値で検索を行います。

準備するテーブル、クエリ、フォーム

テーブル: T_予約台帳

予約のレコードを記録するテーブルを作成します。

テーブル: T_時間マスタ

T_予約台帳で開始時間と終了時間を日付/時刻型ではなく数値型で指定しました。

これは開始時間と終了時間を直接入力ではなく選択式にするのであれば、テーブルで定義しておいてIDで選択させる方が効率的と判断したためです。

そういうわけでこんな感じに15分刻みで時刻を用意し、開始時間と終了時間をそれぞれYes/No型で用意し、表示したい時刻だけチェックを入れるようにします。

クエリ: Q_開始時間_選択, Q_終了時間_選択

T_時間マスタを元に「Q_開始時間_選択」と「Q_終了時間_選択」の２種類の選択クエリを用意します。

Q_開始時間_選択であれば、先ほど作成したYes/No型の開始時間のフィールドを入れて抽出条件を「True」にします。Q_終了時間_選択も同様に終了時間のフィールドで抽出条件を設定します。

クエリ: Q_予約フォーム職員_選択

選択した所属によって表示する職員を絞り込むためのクエリを用意します。

こんな感じ。T_所属情報は前回の記事で作成した各職員の所属情報をまとめたテーブルです。

フォーム上の日付が所属開始日と所属終了日の間にあれば表示するように抽出条件を設定します。

所属の抽出条件「Is Not Null」は、所属が未入力のものがあった時用ですので必須ではありません。

T_所属情報とT_所属マスタとの結合プロパティはこのようにしておきます。リレーションシップの画面で繋がっている線をダブルクリックするとこのプロパティが開けます。

F_予約フォーム

フォームを用意します。デザインビューで編集していきます。

とりあえずやったことを列挙すると、

適当なところで右クリックしてフォームヘッダー/フッターをオンにする
プロパティシートよりレコードソースを「T_予約台帳」にする
「T_予約台帳」の全フィールドをフォームに追加し、配置タブで表形式にする
プロパティシートの既定のビューを「帳票フォーム」にする
開始時間ID、終了時間ID、所属ID、職員IDのフィールドを右クリックしコントロールの種類の変更で「コンボボックス」にする
5のコンボボックスそれぞれのプロパティシートより、値集合ソースをQ_開始時間_選択、Q_終了時間_選択、T_所属マスタ、T_職員マスタにする
5のプロパティシートより、列数を「2」、列幅を「0;」にする
ラベルの書式や列幅など見た目を整える
フォームフッターにラベルとフィールドを複製する
9の各フィールドのコントロールソースを削除して非連結にする
9の各フィールドの名前をキャプチャの通りに変更する
tx職員については値集合ソースを「Q_予約フォーム職員_選択」にする
プロパティシートよりtx日付の既定値を「=Date()」にする
tx日付とcmb所属のイベントタブで更新後処理を「イベントプロシージャ」に設定
tx表示年とcmb表示月を作成し、既定値はtx表示年は「=Year(Date())」、cmb表示月は「=Month(Date())」にして、cmb表示月の値集合ソースを「1,2,3,4,5,6,7,8,9,10,11,12」にする
各ボタンを設置しキャプチャの通り名前をつけてイベントタブでクリック時を「イベントプロシージャ」に設定
オプショングループを「月」「日」で作成し、名前を「frame検索期間」、既定値を「1」にする

ざっとこんな感じ。文章で書くとさっぱりわかりませんが、変更する項目を探して頑張ってください。

VBA

フォーム読み込み時の動作

フォームを読み込んだ際に、開いた日の当月のデータだけ表示するようにフィルターの設定をするようにします。

Private Sub Form_Load()
    Me.FilterOn = False
    Me.Filter = "日付 >= #" & DateSerial(Me.tx表示年, Me.cmb表示月, 1) & "# and 日付 <= #" & DateAdd("d", -1, DateSerial(Me.tx表示年, Me.cmb表示月 + 1, 1)) & "#"
    Me.FilterOn = True
End Sub

所属に応じて職員の絞り込みを行う

所属が変更されると職員の絞り込みが行われるようにします。

Private Sub cmb所属_AfterUpdate()
    Me!cmb職員.RowSource = "select * from Q_予約フォーム職員_選択 where 所属ID = " & Me.cmb所属 & ""
End Sub

日付変更時に職員の所属も変更する

職員の絞り込みはtx日付の値と所属期間も条件です。tx日付が変わっても所属を変更するまで更新が行われないので、tx日付の値を変えるだけで更新されるようにしておきます。

Private Sub tx日付_AfterUpdate()
    DoCmd.Requery "cmb職員"
End Sub

検索を行う

検索の手順としては、順番にフィルターの条件を設定していって最後にフィルターを実行しているだけです。

Private Sub btn検索_Click()
    Dim filterCondition As String
    
    Select Case frame検索期間.Value
        Case 1
            filterCondition = "日付 >= #" & DateSerial(Me.tx表示年, Me.cmb表示月, 1) & "# and 日付 <= #" & DateAdd("d", -1, DateSerial(Me.tx表示年, Me.cmb表示月 + 1, 1)) & "#"

        Case 2
            filterCondition = "日付 = #" & Me.tx日付 & "#"
    End Select
    
    If IsNull(Me.cmb所属) = False Then
        filterCondition = filterCondition & "and 所属ID = " & Me.cmb所属 & ""
    End If
    
    If IsNull(Me.cmb職員) = False Then
        filterCondition = filterCondition & "and 職員ID = " & Me.cmb職員 & ""
    End If
    
    If IsNull(Me.cmb開始時間) = False Then
        filterCondition = filterCondition & " and 開始時間ID =" & Me.cmb開始時間 & ""
    End If
    
    If IsNull(Me.cmb終了時間) = False Then
        filterCondition = filterCondition & " and 終了時間ID =" & Me.cmb終了時間 & ""
    End If
    
    If IsNull(Me.tx備考) = False Then
        filterCondition = filterCondition & " and 備考 like '" & Me.tx備考 & "'"
    End If
    
    Me.Filter = filterCondition
    Me.FilterOn = True
End Sub

frame検索期間.Valueは選んだ方の値が返ってくるので、Select分で分岐させて条件を設定しています。

月で検索する時の月末を取得する方法はポイントですね。

残りはいちいちIsNullがFalseであるかを判定してから条件設定を行っていますが、こうしないとNullもフィルター条件になってしまって意図しない動きになってしまうためこのようにしています。

備考のようなテキストであればlikeを使って文字列を含む条件で設定できます。「”」と「’」の打ち方に注意です。

登録する

今回１番メインのところです。登録は１名と一括の２パターンあってコードの繰り返しを避けるために共通する部分のみプロシージャを分けています。

Private Sub 登録(targetGroup, targetMember)
    Dim Rst As DAO.Recordset
    
    Set Rst = CurrentDb.OpenRecordset("T_予約台帳", dbOpenTable)
        With Rst
            .AddNew
            .Fields("日付") = Me!tx日付
            .Fields("開始時間ID") = Me!cmb開始時間
            .Fields("終了時間ID") = Me!cmb終了時間
            .Fields("所属ID") = targetGroup
            .Fields("職員ID") = targetMember
            .Fields("備考") = Me!tx備考
            .Update
        End With
        
    Rst.Close
    Set Rst = Nothing
End Sub

このプロシージャを呼び出す際に、引数で所属と職員のIDを指定します。

あとは書かれている通りです。こんな感じでテーブルにレコードを追加します。

１名の登録

まずは１名の登録です。途中で出てくる「クリア」は後述します。

Private Sub btn登録_Click()
    Dim targetGroup As Integer
    Dim targetMember As Integer
    
    If IsNull(Me.tx日付) = True Then
        MsgBox "日付が未入力です。"
        
    ElseIf IsNull(Me.cmb開始時間) = True Then
        MsgBox "開始時間が未入力です。"
        
    ElseIf IsNull(Me.cmb終了時間) = True Then
        MsgBox "終了時間が未入力です。"
        
    ElseIf IsNull(Me.cmb所属) = True Then
        MsgBox "所属が未入力です。"
    
    ElseIf IsNull(Me.cmb職員) = True Then
        MsgBox "職員が未入力です。"
        
    Else
        targetGroup = Me.cmb所属
        targetMember = Me.cmb職員
        Call 登録(targetGroup, targetMember)
        Me.Filter = "日付 = #" & Me.tx日付 & "#"
        Me.FilterOn = True
        Call クリア
    End If
End Sub

先に未入力の項目がないか判定してから実際の登録を行います。

まぁ未入力が残っていても特に支障はないのですが一応ね。

一括登録

続いて一括登録。こちらは所属を指定すれば、その所属の全員を同条件で登録するというものです。

Private Sub btn一括登録_Click()
    Dim targetGroup As Integer
    Dim targetMember As Integer
    
    If IsNull(Me.tx日付) = True Then
        MsgBox "日付が未入力です。"
        
    ElseIf IsNull(Me.cmb開始時間) = True Then
        MsgBox "開始時間が未入力です。"
        
    ElseIf IsNull(Me.cmb終了時間) = True Then
        MsgBox "終了時間が未入力です。"
        
    ElseIf IsNull(Me.cmb所属) = True Then
        MsgBox "所属が未入力です。"
    
    Else
        targetGroup = Me.cmb所属
        For i = 0 To cmb職員.ListCount - 1
            targetMember = cmb職員.ItemData(i)
            Call 登録(targetGroup, targetMember)
        Next i
        Me.Filter = "日付 = #" & Me.tx日付 & "#"
        Me.FilterOn = True
        Call クリア
    End If
End Sub

こちらは職員が入力されているかは判定にありません。

あとはcmb職員のリストにある職員全員分のループを回すだけです。

コンボボックスは「コンボボックス.ItemData(n)」で値を取得できます。これはいろんなところで使えそう。

クリア

入力されている項目をクリアします。これらのクリアはいたるところで出てくるのでプロシージャを分けて作ります。

Private Sub クリア()
    Me!cmb開始時間 = Null
    Me!cmb終了時間 = Null
    Me!cmb所属 = Null
    Me!cmb職員 = Null
    Me!tx備考 = Null
End Sub

クリアボタン

クリアボタンを押すと入力していた項目だけでなく、他もフォームを読み込んだ時と同じ状態に戻します。

Private Sub btnクリア_Click()
    Me!tx日付 = Date
    Me.Filter = "日付 >= #" & DateSerial(Me.tx表示年, Me.cmb表示月, 1) & "# and 日付 <= #" & DateAdd("d", -1, DateSerial(Me.tx表示年, Me.cmb表示月 + 1, 1)) & "#"
    Me.FilterOn = True
    Call クリア
End Sub

今回は以上です。この続きがもう少しありまして、次はレポート作成とPDF出力について取り上げる予定です。