Function MonthName(MonthNumber As Integer) As String
' Converts a number (1-12) to month name (January-December)
Dim varMonths As Variant
varMonths = Array("January", "February", "March", "April", _
"May", "June", "July", "August", "September", _
"October", "November", "December")
MonthName = varMonths(MonthNumber - 1)
End Function
Private Sub cboDay_AfterUpdate()
Select Case Me.cboDay.Value
Case 29
If Me.cboMonth.Value = 2 Then
If Me.cboYear.Value / 4 <> Int(Me.cboYear.Value / 4) Then
MsgBox "February has only 28 days in your chosen year. " _
& "I have reset the day box to 28.", vbInformation, "Bad date!"
Me.cboDay.Value = 28
End If
End If
Case Is > 29
Select Case Me.cboMonth.Value
Case 2
If Me.cboYear.Value / 4 = Int(Me.cboYear.Value / 4) Then
MsgBox "February has only 29 days in your chosen year. " _
& "I have reset the day box to 29.", vbInformation, "Bad date!"
Me.cboDay.Value = 29
Else
MsgBox "February has only 28 days in your chosen year. " _
& "I have reset the day box to 28.", vbInformation, "Bad date!"
Me.cboDay.Value = 28
End If
Case 4, 6, 9, 11
If Me.cboDay.Value = 31 Then
MsgBox MonthName(Me.cboMonth.Value) & " has only 30 days. " _
& "I have reset the day box to 30.", vbInformation, "Bad date!"
Me.cboDay.Value = 30
End If
End Select
End Select
Me.txtHireDate.Value = DateSerial(Me.cboYear, Me.cboMonth, Me.cboDay)
End Sub
Private Sub cboMonth_AfterUpdate()
Select Case Me.cboDay.Value
Case 29
If Me.cboMonth.Value = 2 Then
If Me.cboYear.Value / 4 <> Int(Me.cboYear.Value / 4) Then
MsgBox "February has only 28 days in your chosen year. " _
& "I have reset the day box to 28.", vbInformation, "Bad date!"
Me.cboDay.Value = 28
End If
End If
Case Is > 29
Select Case Me.cboMonth.Value
Case 4, 6, 9, 11
If Me.cboDay.Value = 31 Then
MsgBox MonthName(Me.cboMonth.Value) & " has only 30 days. " _
& "I have reset the day box to 30.", vbInformation, "Bad date!"
Me.cboDay.Value = 30
End If
Case 2
If Me.cboYear.Value / 4 = Int(Me.cboYear.Value / 4) Then
MsgBox "February has only 29 days in your chosen year. " _
& "I have reset the day box to 29.", vbInformation, "Bad date!"
Me.cboDay.Value = 29
Else
MsgBox "February has only 28 days in your chosen year. " _
& "I have reset the day box to 28.", vbInformation, "Bad date!"
Me.cboDay.Value = 28
End If
End Select
End Select
Me.txtHireDate.Value = DateSerial(Me.cboYear, Me.cboMonth, Me.cboDay)
End Sub
Private Sub cboYear_AfterUpdate()
If Me.cboMonth.Value = 2 Then
If Me.cboDay.Value = 29 Then
If Me.cboYear.Value / 4 <> Int(Me.cboYear.Value / 4) Then
MsgBox "February has only 28 days in your chosen year. " _
& "I have reset the day box to 28.", vbInformation, "Bad date!"
Me.cboDay.Value = 28
End If
End If
End If
Me.txtHireDate.Value = DateSerial(Me.cboYear, Me.cboMonth, Me.cboDay)
End Sub
Private Sub Form_Current()
If IsNull(Me.txtHireDate) Then
Me.cboDay.Value = Day(Date)
Me.cboMonth.Value = Month(Date)
Me.cboYear.Value = Year(Date)
Else
Me.cboDay = Day(Me.txtHireDate.Value)
Me.cboMonth = Month(Me.txtHireDate.Value)
Me.cboYear = Year(Me.txtHireDate.Value)
End If
End Sub
Private Sub txtHireDate_Click()
MsgBox "Please select a date from the Date Chooser." _
, vbInformation, "You can't type here."
End Sub