I have seen several requests for a masked date box. Here's a simple one for anyone who's interested. It's messy, but feel free to post better ones.
Make a new form and place a text box on it called Text1
Code:Dim Selected As Integer 'The selected aspect of the date
Dim curDate As String 'The current text (before invalid keypresses)
Dim BadKey As Boolean
Private Sub SelectIt()
'Select a particular aspect of the date
Select Case (Selected)
Case 0 'No selection
Text1.SelStart = 0
Text1.SelLength = 0
Case 1 'Day
Text1.SelStart = 0
Text1.SelLength = 2
Case 2 'Month
Text1.SelStart = 3
Text1.SelLength = 2
Case 3 'Year
Text1.SelStart = 6
Text1.SelLength = 4
End Select
End Sub
Private Function ValidateDate(DateStr As String) As Boolean
'Returns False for an invalid date, or True for a valid one
Dim dTemp As Date
ValidateDate = True
On Error GoTo BadDate
'This will cause an error if the date is invalid
dTemp = Day(DateStr) & "/" & Month(DateStr) & "/" & Year(DateStr)
On Error GoTo 0
Exit Function
BadDate:
ValidateDate = False
End Function
Private Sub Form_Load()
'Put todays date in text1
Text1.Text = Format$(Date, "DD/MM/YYYY")
curDate = Text1
Selected = 0
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim TempVal As Integer
Dim TempStr As String
SelectIt
BadKey = False
Select Case (KeyCode)
Case vbKeyRight
curDate = Text1
If Selected < 3 Then Selected = Selected + 1
Case vbKeyLeft
curDate = Text1
If Selected > 1 Then Selected = Selected - 1
Case vbKeyEnd
curDate = Text1
Selected = 3
Case vbKeyHome
curDate = Text1
Selected = 1
Case vbKeyUp
curDate = Text1
TempVal = Val(Text1.SelText)
TempVal = TempVal + 1
TempStr = Trim(Str(TempVal))
If Len(TempStr) = 1 Then TempStr = "0" & TempStr
Text1.SelText = TempStr
If ValidateDate(Text1) = False Then
Text1 = curDate
End If
Case vbKeyDown
curDate = Text1
TempVal = Val(Text1.SelText)
TempVal = TempVal - 1
TempStr = Trim(Str(TempVal))
If Len(TempStr) = 1 Then TempStr = "0" & TempStr
Text1.SelText = TempStr
If ValidateDate(Text1) = False Then
Text1 = curDate
End If
Case Else
BadKey = True
End Select
SelectIt
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
If BadKey = True Then
Text1 = curDate
End If
SelectIt
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Text1.SelStart < 3 Then
Selected = 1
ElseIf Text1.SelStart > 2 And Text1.SelStart < 6 Then
Selected = 2
Else
Selected = 3
End If
SelectIt
End Sub
