SBMJOB日付入力テキストボックスにデートピッカーを設置しましたが、曜日をつけてくれとの依頼で実装したものの上手く曜日は曜日が表示されず、かつ日付のエラーチェックが上手く動かなくなっちゃいました。そんなときの解決方法をご紹介します。
フォームとプロパティー概要
日付のテキストボックスにyyyy/mm/dd(曜日)と表示させての比較です。（曜）を別のテキストボックスを作ってそっちに表示させる方法もありますが今回は一つのテキストボックスに曜日まで入れた場合の判定を実装してみます。
日付を比較ボタンを押した結果
この例ではFromを左、Toを右と称して日付の大小を比較しています。
曜日を含むテキストボックスの挙動
テキストボックスに日付をテキストでセットする場合、
規定値でFormat(Now(),”yyyy/mm/dd(aaa)”)とすれば、曜日を日付の後ろに
セットすることができます。
しかしデートピッカーで変更すると曜日が消えてしまいます。
さらに、日付の大小を比較するともちろんテキストなんでCdateで日付型に
キャストしてから比較するんですが、曜日（月）とか（火）等が入っているので
キャストできず型エラーになります。
比較のための仕組み作り
そこでテキストボックスをlikeで *(*)* 文字パターンの存在チェックし
曜日がはいいていたら三文字取り除き、Cdateでキャストして日付比較します。
テキスト同士で比較すると絶対に予想しない動きをするので
必ずCdateで日付型にキャストしましょう。
日付の比較をしています。
Private Sub コマンド12_Click()'ボタンクリック
If changeToDateFormat(Me.txtDayFrom) > changeToDateFormat(Me.txtDayTo) Then
MsgBox ("左が大きいよ")
Else
MsgBox ("右が大きいよ")
End If
End SubこのFunctionは曜日付きでも曜日なしでも日付をstringで受け取り、
必要に応じて日付削除処理を行い、Date型でかえしています。そうすれば日付比較ができます。
Private Function changeToDateFormat(ByVal recieveDate As String) As Date
'曜日が含まれていたらチェックして後ろから三文字削除する。
If recieveDate Like "*(*)*" Then
Dim i As Integer
i = Len(recieveDate)
i = i - 3
changeToDateFormat = CDate(Left(recieveDate, i))
Else
changeToDateFormat = CDate(recieveDate)
End If
End Functionデートピッカーでの曜日消失対応仕組み作り
日付テキストボックスが更新されたら、以下の処理をおこない曜日を右から添える。
テキストボックスへの曜日付加セット処理
Private Sub txtDayFrom_AfterUpdate()
Me.txtDayFrom = changeToYoubiAdd(Me.txtDayFrom)
End Sub
Private Sub txtDayTo_AfterUpdate()
Me.txtDayTo = changeToYoubiAdd(Me.txtDayTo)
End SubPrivate Function changeToYoubiAdd(ByVal recieveDate As String) As String
If recieveDate Like "*(*)*" Then
'曜日あり
changeToYoubiAdd = recieveDate
Else
'曜日なし
changeToYoubiAdd = Format(CDate(recieveDate), "yyyy/mm/dd(aaa)")
End If
End Functionまとめ
日付をテキストボックスでデートピッカーを使用しながらシステムに組み込むと若干めんどくさいですが、デートピッカーは便利なので使わない手はありません。その場合の問題点を解決してみました。考え方が原始的なので理解はしやすいと思いますので皆様ぜひ試してみてください。
コメント