饂飩コーディング

iOSアプリやら、Unityやら、Cocos2dやらごにょごにょ書いております

Accessのテクストボックスで日付に曜日をつけて日付比較する

Access VBA

f:id:appdeappuappu:20201109223607p:plain
f:id:appdeappuappu:20201109223739p:plain
f:id:appdeappuappu:20201109224749p:plain


テキストボックスに日付をテキストでセットする場合、
規定値でFormat(Now(),"yyyy/mm/dd(aaa)")とすれば、曜日を日付の後ろに
セットすることができますが、デートピッカーで変更すると曜日が消えてしまいます。

さらに、日付の大小を比較するともちろんテキストなんでCdateで日付型に
キャストしてから比較するんですが、曜日（月）とか（火）等が入っているので
キャストできず型エラーになります。

そこでテキストボックスをlikeで　*(*)*　文字パターンの存在チェックし
曜日がはいいていたら三文字取り除き、Cdateでキャストして日付比較します。

テキスト同士で比較すると絶対に予想しない動きをするので
必ずCdateで日付型にキャストしましょう。




日付テキストボックスが更新されたら、以下の処理をおこない曜日を右から添える。

Private Sub txtDayFrom_AfterUpdate()
    Me.txtDayFrom = changeToYoubiAdd(Me.txtDayFrom)
End Sub

Private Sub txtDayTo_AfterUpdate()
    Me.txtDayTo = changeToYoubiAdd(Me.txtDayTo)
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 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

日付の比較をしています。

Private Sub コマンド12_Click()

    If changeToDateFormat(Me.txtDayFrom) > changeToDateFormat(Me.txtDayTo) Then
        MsgBox ("左が大きいよ")
    Else
        MsgBox ("右が大きいよ")
    End If
    
    End Sub

AccessでWizHook使ってみよう。

AccessでExelファイルのエクスポートやインポートするときには

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "T-顧客", "ディレクトリ"
やら、
DoCmd.TransferSpreadsheet acImport, Excelのバージョン指定, インポート先テーブル名, Excelファイルパス, 先頭行を列名にする時はtrue, 取り込みシート名

VBAでやっちゃいますが、ダイアログボックスほしいですよね。
Microsoft推奨は以下のやり方かな。
appdeappuappu.hateblo.jp


インポートはAccess Object Liblaryでダイアログボックスを作り、
エクスポートはExce Object Liblaryを使ってダイアログを作ります。
f:id:appdeappuappu:20201106204721p:plain
それぞれ別の参照設定を設定すれば実装できるのですが、
Excel Object Liblaryを使った場合、Accessの画面の裏にダイアログが表示されることがあって
実務では「あれ？Access固まった？？」的な事に陥ります。

そこで使えるのがWizHookです！！！

不要な参照設定を入れなくても使えるし、画面裏にまわることもないので使いやすいです。
マイクロソフトでは非推奨扱いなのは少々難ありですが使ってみましょう。非推奨なだけあって
公式情報での説明等は一切ない代わりに、ネット上にはいろいろ情報がころがっています。
検索してみると引数が時折変更になってるとかなってないとか・・・

オブジェクトブラウザで非表示項目を表示するとこんな感じで隠してあります。
引数もここで確認できるといえばできますね。
f:id:appdeappuappu:20201106220140p:plain


参考になるのがこちらのSE Life Log - VBAを中心にその他IT備忘録さんの記事。
https://selifelog.com/blog-entry-53.html

さて、実装してみます。


まずは、標準モジュールにWizHookをFunctionとして記述し保存します。

Function GetFileName(OpenOrSaveFlg As Boolean, strFilter As String, strTitle As String, defaultFileName As String) As Variant
    
    Dim returnValue As Integer
    Dim strFilePath As String
    
    If strFilter = "" Then
        strFilter = "全てのファイル (*.*)|*.*"
    End If
   
    WizHook.Key = 51488399 'WIZHOOK有効
    
    returnValue = WizHook.GetFileName( _
                    0, "", strTitle, "", defaultFileName, "", _
                    strFilter, _
                    0, 0, 0, OpenOrSaveFlg _
                    )
    WizHook.Key = 0 ' WizHook 無効
    'returnValueとstrFilePathの2つの値を返す
    'returnvalueの値を返すことで[キャンセル]が押されたかを判断するため
    GetFileName = Array(returnValue, strFilePath)
   
End Function


ボタンを押して呼び出す側はこんな感じで！

    Private Sub コマンド_エクスポート_Click()
    
    Dim sFina As String
    
    Dim ReturnArray As Variant
    ReturnArray = GetFileName(False, "ログファイル (*.xlsx)|*.xlsx|", "ダイアログタイトル", "sample.xlsx")
    
    If ReturnArray(0) = -302 Then
        'キャンセルボタンが押されたときの処理を記述
        MsgBox "キャンセルが押されました。"
    Else
        'ファイルが指定されたとこの処理を記述
        MsgBox ReturnArray(1)
        sFina = ReturnArray(1)
    End If
    
    If sFina <> "" Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "売上テーブル", sFina, True, "シートxxx"
        
    End If
    
    
End Sub


以下のようなダイアログが表示されて使いやすくなります。
f:id:appdeappuappu:20201106234915p:plain


なお、エクスポート時は保存用のダイアログとして
インポート時は読み取り（ファイルを開く）ダイアログとして使用できます。
使い分けは
ReturnArray = GetFileName(False, "ログファイル (*.xlsx)|*.xlsx|", "ダイアログタイトル", "sample.xlsx")
第一引数 False = 保存用のダイアログ
　　　　 True =　読み取り用のダイアログ
となります。