Function 访问VBA get函数将数据传递给Sub的Cancel属性

我在一张表格上有很多日期，并开始逐一验证。希望用一个函数替换所有这些检查，该函数可以从每个“更新前”事件调用。问题是，当验证失败时，我无法将焦点保持在控件上

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

我试过：

Call CheckDate(xray_date) 

它显示正确的消息，但将焦点从控件移开，而不是将其保留在那里进行编辑

Cancel = CheckDate(xray_date) 

---

似乎什么也不做，允许将无效数据传递给存储。那么，当验证失败时，我应该如何调用该函数才能将BeforeUpdate的Cancel事件设置为True呢？

我很难理解您的示例代码，所以我构建了一个包含日期/时间字段的表：Date\u of_birth；第一次看到的日期；还有X光片。然后基于该表构建一个表单，并将这些文本框绑定到这些字段：txtDate_of_birth；txtDate_首次出现；和txtXray_日期

这是我表单的代码模块，它会根据需要验证

txtray\u 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

选项比较数据库
选项显式
私有函数CheckDate（ctlDate作为文本框）作为整数
Const clngChecks As Long=3'将其更改为与数字匹配
“For循环中的条件”
Const cstrTitle As String=“无效日期”
我想我会坚持多久
以整数形式返回
将lngButtons变暗为长
作为字符串的Dim strPrompt
像线一样暗的线
lngButtons=vb感叹号
strPrompt=vbNullString'使其显式
intReturn=0'使其显式
对于i=1至CLNG检查
选择案例一
案例1
“出生日期必须在任何其他日期之前
如果ctlDateDateTime.Date，则
strcompt=“此日期在将来”
退出
如果结束
案例3
'所有调查/治疗日期必须大于等于首次看到的日期
如果ctlDate0，则
MsgBox strcompt、lngButtons、cstrTitle
intReturn=-1
如果结束
CheckDate=intReturn
端函数
私有子txtXray\u日期\u更新前（取消为整数）
取消=检查日期（Me.txtXray\U日期）
端接头

@Hansup函数的签名

CheckDate（datefield为TextBox）

除了一个文本框之外不可能传递任何东西吗？@Hansup那么我错过了

Cancel=CheckDate（xray_date）

似乎没有做任何事情，而

调用CheckDate（xray_date）

做了，这不应该是这样的，也许你已经了解了一些事情。我认为你不应该在控件级别检查这些日期，而应该使用表单的BefereUpdate事件。在这里，您有一个取消选项，并且在用户尝试保存所有内容之前，您不会打扰用户。不要忘记，您不控制用户填充控件的顺序！他是老鼠的主人。我得出了同样的结论。也许如果OP做了一个调试->编译，它可能会有一些启发。@HansUp:我已经用你的函数替换了我的函数，但仍然有困难。首先，我收到一条关于Me关键字无效使用的消息，所以我将其删除，但随后没有定义出生的txtDate，所以我将其更改为[Forms]！[表格]！[出生日期]。但是，它的工作原理与我的函数完全相同，它显示了消息框，但随后控件从选中的日期移动到窗体上的下一个控件，并且将无效日期保存到表中。很抱歉，我的原始代码看起来很混乱，这是使用VBA的新手。关于

Me

关键字无效使用的错误建议您将该代码存储在其他模块中，而不是表单的代码模块中。我想不出任何其他原因为什么

Me

会无效。@HansUp:将它从单独的模块（我拥有所有函数）移动到主模块，尽管它接受我，同样的问题仍然存在-出现了消息框，但焦点移到下一个控件，并存储无效数据解决了问题所在-就像将VBEQUOTION替换为vbOKOnly一样简单！HansUp，谢谢你的帮助，在我的代码中，你的函数的骨架也被证明非常有用。关于我的下一个问题现在。。。

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