کدهای فرم:
Option Compare Database
Option Explicit
Dim FormStatus As String
Dim Error2169 As Boolean
Private Sub Form_Load()
Error2169 = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Error2169 Then
If MsgBox("All data changes droped," & vbCrLf & "Close form?" & vbCrLf & "OK: Close form" & vbCrLf & "CANCEL: Continue editing", vbQuestion + vbOKCancel, "") = vbCancel Then
Cancel = True
Error2169 = False
Else
Cancel = False
End If
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
ValidateForm
If FormStatus <> "OK" Then
v = MsgBox("Correct the following items:" & vbCrLf & vbCrLf & FormStatus, vbExclamation, "Form Validation")
Cancel = True
End If
End Sub
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Select Case DataErr
Case 3022
Dim FullName As String
FullName = DLookup("FirstName & ' ' & LastName", "Persons", "NCode='" & Me.NCode & "'")
v = MsgBox("National Code " & Me.NCode & vbCrLf & "already registered to :" & FullName, vbExclamation, "Duplicate National Code")
Response = acDataErrContinue
Case 3314
v = MsgBox(Me.ActiveControl.Properties("DatasheetCapti on"), vbExclamation, "Required Field Is Empty")
Response = acDataErrContinue
Case 2279
v = MsgBox(Me.ActiveControl.Properties("DatasheetCapti on"), vbExclamation, "Input Mask Is Incomplete")
Response = acDataErrContinue
Case 2169
Error2169 = True
Response = acDataErrContinue
Case Else
Response = acDataErrDisplay
End Select
End Sub
Sub ValidateForm()
Dim D As New Dictionary
Dim x As String
Error2169 = False
x = ValidNcode(Me.NCode)
If x <> OK Then
D.Add x, D.Count
End If
x = ValidName(Me.FirstName)
If x <> OK Then
D.Add "First Name " & x, D.Count
End If
x = ValidName(Me.LastName)
If x <> OK Then
D.Add "Last Name " & x, D.Count
End If
If IsNull(Me.BirthDate) Then
D.Add "Birth Date is required", D.Count
End If
x = ValidHireDate(Me.BirthDate, Me.HireDate)
If x <> OK Then
D.Add x, D.Count
End If
x = ValidMobile(Me.Mobile)
If x <> OK Then
D.Add x, D.Count
End If
If D.Count = 0 Then
FormStatus = "OK"
Else
FormStatus = Join(D.Keys, vbCrLf)
End If
End Sub
Private Sub FirstName_AfterUpdate()
Me.FirstName = FullTrim(Me.FirstName)
End Sub
Private Sub LastName_AfterUpdate()
Me.LastName = FullTrim(Me.LastName)
End Sub
Private Sub Sex_NotInList(NewData As String, Response As Integer)
Me.Sex = 0
Response = acDataErrContinue
End Sub
پاسخ با نقل قول