Access VBA get CancelプロパティのSubにデータを渡す関数

Question

フォーム上に日付の数があり、それぞれ個別に検証を開始しました。これらすべてのチェックを、それぞれの「更新前」イベントから呼び出すことができる1つの関数に置き換えることを望んでいました。問題は、検証に失敗したときにコントロールにフォーカスを置くことができないということです。

Public Function CheckDate(datefield As TextBox) As Integer 

Dim this_date As Date 
Dim DOB As Date 
Dim first_seen As Date 
this_date = Conversion.CDate(datefield.text) 
DOB = [Forms]![generic]![date_of_birth] 
first_seen = [Forms]![generic]![date_first_seen] 

If Not IsNull(this_date) Then 
    'date of birth must precede any other date 
    If this_date < DOB Then 
     MsgBox "This date precedes the date of birth", vbExclamation, "Invalid date" 
     CheckDate = -1 
     Exit Function 
    End If 
    'date can't be in the future 
    If this_date > DateTime.Date Then 
     MsgBox "This date is in the future", vbExclamation, "Invalid date" 
     CheckDate = -1 
     Exit Function 
    End If 
    'all investigation/treatment dates must be >= date first seen 
    If Not IsNull(first_seen) Then 
     If this_date < first_seen Then 
      MsgBox "This date precedes the date patient was first seen", vbExclamation, "Invalid date" 
      CheckDate = -1 
      Exit Function 
     End If 
    End If 
End If 

End Function 

は

Private Sub xray_date_BeforeUpdate(Cancel As Integer) 

内で私が試してみた：正しいメッセージが表示されなく移動し、編集のためにそこにそれを維持するのではなく、コントロールからのフォーカス

Call CheckDate(xray_date) 

。

Cancel = CheckDate(xray_date) 

は、無効なデータをストレージに引き渡すことはできません。では、検証が失敗したときにBeforeUpdateのCancelイベントをTrueに設定するには、どのように関数を呼び出す必要がありますか？

Answer 1

サンプルコードを理解するのに苦労したので、Date/Timeフィールドを持つテーブルを作成しました。date_of_birth; date_first_seen;とxray_date。これらのフィールドにバインドされたこれらのテキストボックスを使用して、そのテーブルに基づいたフォームを作成しました：txtDate_of_birth; txtDate_first_seen;およびtxtXray_date。

これは私のフォームのコードモジュールで、AFAICTはtxtXray_dateを必要に応じて検証します。

Option Compare Database 
Option Explicit 

Private Function CheckDate(ctlDate As TextBox) As Integer 
    Const clngChecks As Long = 3 ' change this to match the number 
           ' of conditions in the For loop 
    Const cstrTitle As String = "Invalid date" 
    Dim i As Long 
    Dim intReturn As Integer 
    Dim lngButtons As Long 
    Dim strPrompt As String 
    Dim strTitle As String 

    lngButtons = vbExclamation 
    strPrompt = vbNullString ' make it explicit 
    intReturn = 0 ' make it explicit 

    For i = 1 To clngChecks 
     Select Case i 
     Case 1 
      'date of birth must precede any other date 
      If ctlDate < Me.txtDate_of_birth Then 
       strPrompt = "This date precedes the date of birth" 
       Exit For 
      End If 
     Case 2 
      'date can't be in the future 
      If ctlDate > DateTime.Date Then 
       strPrompt = "This date is in the future" 
       Exit For 
      End If 
     Case 3 
      'all investigation/treatment dates must be >= date first seen 
      If ctlDate < Me.txtDate_first_seen Then 
       strPrompt = "This date precedes the date patient was first seen" 
       Exit For 
      End If 
     End Select 
    Next i 

    If Len(strPrompt) > 0 Then 
     MsgBox strPrompt, lngButtons, cstrTitle 
     intReturn = -1 
    End If 
    CheckDate = intReturn 
End Function 

Private Sub txtXray_date_BeforeUpdate(Cancel As Integer) 
    Cancel = CheckDate(Me.txtXray_date) 
End Sub