Доступ к функции VBA get для передачи данных в 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) 

, похоже, ничего не делает, что позволяет передавать недопустимые данные на хранение.Итак, каким образом я должен вызывать функцию, чтобы событие CancelU до обновления было установлено в значение 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