Format textboxes for dates

[Lieven Mettepenningen]

Here's my question:

I have a userform with a few textboxes on it, and I want the textboxes to
display only values of the form dd/mm/yyyy ALL THE TIME. The checking of the
day-, month- and year-values shouldn't happen until I leave the textbox. But
I want to use the keypress-event of the boxes to guarantee the right format
all the time. I've already managed to do this for typing new values, so I
only accept numbers from now on. This all works fine, but if I want to erase
my date, I want to manipulate my textbox so I can erase the numbers, but NOT
the slashes, so that I can't empty the box completely. It should contain
always at least: "//".

Does anyone know the answer to my problem?

Thx,

Lieven
_______________________________________________________________________

Lieven Mettepenningen
Software Designer
mailto:[email protected]

NISUS Software Architects
Antwerpsesteenweg 107, B-2390 Oostmalle
Tel : +32(0)3/312.92.30 Fax : +32(0)3/311.72.90
http://www.nisus.be

 

[Dick Kusleika]

Lieven

I tried to do this too. I tried to emulate an InputMask like you would find
in Access. Below is the code, but I warn you there are problems that still
need to be fixed.

Dim OldText As String
Dim Pos As Long

Private Sub tb1_Enter()

If Len(Me.tb1.Text) = 0 Then
Me.tb1.Text = "__/__/__"
Me.tb1.SelStart = 0
Me.tb1.SelLength = 1
Else
Me.tb1.SelStart = 0
Me.tb1.SelLength = Len(Me.tb1.Text)
End If

End Sub

Private Sub tb1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift
As Integer)

OldText = Me.tb1.Text
Pos = Me.tb1.SelStart

Select Case KeyCode.Value
Case 8
Select Case Me.tb1.SelStart
Case 1, 2, 4, 5, 7, 8
Me.tb1.Text = Left(OldText, Pos - 1) & _
"_" & Mid(OldText, Pos + 1, 255) & "_"
Case 3, 6
Me.tb1.Text = Left(OldText, Pos - 2) & _
"_" & Mid(OldText, Pos, 255) & "_"
Pos = Pos - 1
End Select
End Select

End Sub

Private Sub tb1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
Integer)
'MsgBox KeyCode.Value

Select Case KeyCode.Value
Case 27
'esc
Me.tb1.Text = "__/__/__"
Me.tb1.SelStart = 0
Me.tb1.SelLength = 1
Case 96 To 105, 32, 39
'0 to 9, space and right arrow
'MsgBox Me.tb1.SelStart
Select Case Me.tb1.SelStart
Case 0, 1, 3, 4, 6, 7
Me.tb1.SelLength = 1
Case 2, 5
Me.tb1.SelStart = Me.tb1.SelStart + 1
Me.tb1.SelLength = 1
End Select
Case 8
'backspace
Me.tb1.SelStart = Pos + CLng(Pos > 0)
Me.tb1.SelLength = 1
Case 111
'slash
Select Case Pos
Case Is < 2
Me.tb1.Text = OldText
Me.tb1.SelStart = 3
Me.tb1.SelLength = 1
Case 2, 5
Me.tb1.SelLength = 1
Case Is < 5
Me.tb1.Text = OldText
Me.tb1.SelStart = 6
Me.tb1.SelLength = 1
Case Is < 8
Me.tb1.Text = OldText
Me.tb1.SelStart = Pos
Me.tb1.SelLength = 1
End Select
Case 37
'left arrow
Select Case Me.tb1.SelStart
Case 0
Me.tb1.SelLength = 1
Case 1, 2, 4, 5, 7, 8
Me.tb1.SelStart = Me.tb1.SelStart - 1
Me.tb1.SelLength = 1
Case 3, 6
Me.tb1.SelStart = Me.tb1.SelStart - 2
Me.tb1.SelLength = 1
End Select
Case 38
'up arrow
Me.tb1.SelLength = 1
Case 40
'down arrow
Me.tb1.SelStart = Me.tb1.SelStart - 1
Me.tb1.SelLength = 1
Case 13, 9
'Enter and tab do nothing
Case Else
Beep
If Len(OldText) = 0 Then
OldText = "__/__/__"
End If
Me.tb1.Text = OldText
Debug.Print Pos, KeyCode.Value
Me.tb1.SelStart = Pos
Me.tb1.SelLength = 1

End Select

End Sub