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_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

访问VBA get函数将数据传递给Sub以获取其Cancel属性

1 个答案: