ココがポイント
非連結ボックスのテキストボックスや非連結のコンボボックスの値が入力されているのか?ないのか?の判定をしてデータを抽出したい
というのが今回の目的です。
非連結テキストボックス(コンボボックス)値の有無
そんなの簡単だよって思っていましたが、自分が思うような判定ができません。
値が入っているなら、
IsNull(pu_date_start) or pu_date_start=""
で値が入ってない時を判別できるんじゃないの?
ココに注意
思ったような判別ができません
If Nz(Me.pu_date_start, "") <> "" And Nz(Me.pu_date_end, "") <> "" Then hantei = hantei + 1 ElseIf Nz(Me.pu_date_start, "") <> "" Then If Nz(Me.pu_date_end, "") = "" Then MsgBox "集荷日終了が入力されていません" Exit Sub End If ElseIf Nz(Me.pu_date_end, "") <> "" Then If Nz(Me.pu_date_start, "") = "" Then MsgBox "集荷日開始が入力されていません" Exit Sub End If End If If Nz(Me.delivery_date_start, "") <> "" And Nz(Me.delivery_date_end, "") <> "" Then hantei = hantei + 10 ElseIf Nz(Me.delivery_date_start, "") <> "" Then If Nz(Me.delivery_date_end, "") = "" Then MsgBox "配達日終了が入力されていません" Exit Sub End If ElseIf Nz(Me.delivery_date_end, "") <> "" Then If Nz(Me.delivery_date_start, "") = "" Then MsgBox "配達日開始が入力されていません" Exit Sub End If End If
いろいろと試した結果、
Nz(Me.pu_date_start, "") <> "" ⇒ 値が有り
Nz(Me.pu_date_start, "") = "" ⇒ 値が無い
という方法がちゃんと判別することができました。
上のコードは、日付範囲を設定するフォームになりますが、範囲開始か、範囲終了のどちらかに値がある場合は、値が無い方をメッセージボックスを出現させて警告をするものです。
値のある非連結テキストボックスだけ抽出
複数の非連結テキストボックスや、非連結のコンボボックスなどで、大量のデータから目的のデータを抽出してレコードソースにしたい時がある。
そこで、抽出ワード(値)があるものだけで抽出して、無い時はスルーするという事がやりたかったことです。
ただVBAコードを載せておくだけになってしまっていますが、テキストだったり、日付などが複数混ざっている状態の「’」「”」「&」って本当に難しいので自分の備忘録として乗せておくことにしました。
Public Sub tyushutsu_btn_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim hantei As Integer Dim naiyou As String ' hanteiの数値により、抽出項目に値があるのかを判定している。 haitei = 0 If Nz(Me.pu_date_start, "") <> "" And Nz(Me.pu_date_end, "") <> "" Then hantei = hantei + 1 ElseIf Nz(Me.pu_date_start, "") <> "" Then If Nz(Me.pu_date_end, "") = "" Then MsgBox "集荷日終了が入力されていません" Exit Sub End If ElseIf Nz(Me.pu_date_end, "") <> "" Then If Nz(Me.pu_date_start, "") = "" Then MsgBox "集荷日開始が入力されていません" Exit Sub End If End If If Nz(Me.delivery_date_start, "") <> "" And Nz(Me.delivery_date_end, "") <> "" Then hantei = hantei + 10 ElseIf Nz(Me.delivery_date_start, "") <> "" Then If Nz(Me.delivery_date_end, "") = "" Then MsgBox "配達日終了が入力されていません" Exit Sub End If ElseIf Nz(Me.delivery_date_end, "") <> "" Then If Nz(Me.delivery_date_start, "") = "" Then MsgBox "配達日開始が入力されていません" Exit Sub End If End If If Nz(Me.search_mado, "") <> "" Then ' 出荷人 hantei = hantei + 100 End If If Nz(Me.trader_search, "") <> "" Then ' 業者 hantei = hantei + 1000 End If If Nz(Me.delivery_mado, "") <> "" Then ' 配達先 hantei = hantei + 10000 End If ' 長くなってしまった抽出項目を変数にしました。 naiyou = "(trader1 ='" & Me!trader_search & "'or trader2 = '" & Me!trader_search & "'or trader3 = '" & Me!trader_search & "'or trader4 = '" & Me!trader_search & "'or trader5 = '" & Me!trader_search & "')" On Error GoTo Err_Handler Set cn = CurrentProject.AccessConnection Set rs = New ADODB.Recordset With rs Set .ActiveConnection = cn If hantei = 100 Then ' 出荷人 .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "'" ElseIf hantei = 101 Then ' 出荷人+集荷日 .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" ElseIf hantei = 111 Then ' 出荷人+集荷日+配達日 .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & "And delivery_date Between #" & Me!delivery_date_start & "# AND #" & Me!delivery_date_end & "#" ElseIf hantei = 10101 Then ' 出荷人+配達先+集荷日 .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "'And delivery_name = '" & Me!delivery_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" ElseIf hantei = 11 Then ' 集荷日+配達日 .Source = "SELECT * FROM orderdata_sorting WHERE pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & "And delivery_date Between #" & Me!delivery_date_start & "# AND #" & Me!delivery_date_end & "#" ElseIf hantei = 1000 Then ' 業者 .Source = "SELECT * FROM orderdata_sorting WHERE " & naiyou ElseIf hantei = 11000 Then ' 業者+配達先 .Source = "SELECT * FROM orderdata_sorting WHERE delivery_name = '" & Me!delivery_mado & "' and " & naiyou ElseIf hantei = 11001 Then ' 業者+配達先+集荷日 .Source = "SELECT * FROM orderdata_sorting WHERE delivery_name = '" & Me!delivery_mado & "' and pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and " & naiyou ElseIf hantei = 1001 Then ' 業者+集荷日 .Source = "SELECT * FROM orderdata_sorting WHERE pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and " & naiyou ElseIf hantei = 1101 Then ' 出荷人+業者+集荷日 .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and " & naiyou ' Debug.Print .Source Else MsgBox "設定外の抽出項目です。設定し直して再抽出してください。" Exit Sub End If .LockType = adLockOptimistic .CursorType = adOpenKeyset .Open End With Set Me.Recordset = rs rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing ExitErr_Handler: Exit Sub Err_Handler: MsgBox "エラー: " & Err.description rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub
抽出したレコードソースを更新すると・・・
抽出たレコードをVBAコードで更新などをする時は、レコードを再抽出しないと更新したデータが表示されていません。
なので、更新後に、本当のレコードをレコードソースにする必要があります。
抽出を解除するときと同じコードを使えばいいので、Publicにして使っています。
Private Sub 解除ボタン_Click() On Error GoTo Err_Handler Set cn = CurrentProject.AccessConnection Set rs = New ADODB.Recordset With rs Set .ActiveConnection = cn .Source = "orderdata_sorting" .LockType = adLockOptimistic .CursorType = adOpenKeyset .Open End With Set Me.Recordset = rs rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing ExitErr_Handler: search_mado = "" trader_search = "" delivery_mado = "" pu_date_start = "" pu_date_end = "" delivery_date_start = "" delivery_date_end = "" Exit Sub Err_Handler: MsgBox "エラー: " & Err.description rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub
そうすると問題なのが、
帳票フォームなどにしている場合は、カーソルがレコードの先頭に行ってしまうので、スクロールして値が変わった事を確認しないとならないのです。
また、Accessを再起動しても、抽出されたレコードソースは解除しないかぎり抽出されたままのフォームデータなので、自分の場合は、フォームを開く時に、この解除のVBAを動かすようにしています。
なので、抽出する場合は、数件程度のレコードになるようにするくらいの条件設定が必要だと考えます。
もしくは、もっと良い方法があるなら教えてほしい。
もっとスマートにやる方法は無いのか?
どうも、Accessというソフトは、帳票フォームにすると一気に使いづらくなります。
通常作業としては、帳票フォームで条件を絞ったのちに、エクセルのように、上から順々に処理をしていきたい事が多いと思います。
しかし、VBAコードなどでデータ更新をかけると画面を再表示させない限り、データが最新になりません。
テーブルをダイレクトに更新するってやり方ならいいのかもしれませんが、それはそれでヒューマンミスが怖いです。
ココがダメ
もっとスマートに帳票フォームから値を抽出後、リアルタイムでデータ更新ができるようにならないものかと要望
します。