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




Reply With Quote