Access VBA获取Function以将数据传递给Sub的Cancel属性

Question

我在一个表单上有很多日期，并开始分别验证它们。希望用一个函数替换所有这些检查，该函数可以从每个"更新前"事件中调用。问题是，当验证失败时，我无法将注意力集中在控件上。

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_of_fornth；date_firstrongeen；以及xray_ date。然后基于该表构建了一个表单，并将这些文本框绑定到这些字段：txtDate_of_forn；txtDate_firstrongeen；以及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