finaljustice
Board Regular
- Joined
- Oct 6, 2010
- Messages
- 175
Hello, I have found this great code which makes the textbox accept DATES and inserts the "/" when the user writes a date in ddmmyy or ddmmyyyy automatically as dd/mm/yy or dd/mm/yyyy. It works perfectly fine but if the user tries to insert the date with the "/" such as 15/11/11 instead of 151111 the code becomes buggy, it will accept the format but will keep giving the error code consistently.
Does anyone have any ideas on how to make the code accept as well the user insert the date with the "/" and not stay bugging?
My inicial idea was to try and insert another separate code for the same textbox which evaluates what is being typed. But VBA does allow (for what i know two separte codes for a same object.
Here is what I mean:
Any suggestions are welcome.
Thanks for your attention.
Final
Does anyone have any ideas on how to make the code accept as well the user insert the date with the "/" and not stay bugging?
My inicial idea was to try and insert another separate code for the same textbox which evaluates what is being typed. But VBA does allow (for what i know two separte codes for a same object.
Here is what I mean:
Code:
Private Sub TextBox124_Change()
On Error GoTo myErr
If TextBox124.Value = xlNull Then Exit Sub
If Application.WorksheetFunction.IsNumber(TextBox124.Value * 1) = False Then
myErr:
MsgBox "Inserir somente números.", 48, "Somente números."
End If
End Sub
Private Sub TextBox124_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim objRegex As Object
Dim objMatches As Object
Dim strDDMM As String
Dim strRegex
strRegex = "^((0[1-9])|([12][0-9])|(3[01]))" & _
"((0[1-9])|(1[012]))" & _
"(19|20)?(\d\d)$"
Set objRegex = CreateObject("VBScript.Regexp")
With objRegex
.Pattern = strRegex
.Global = False
Set objMatches = .Execute(TextBox124.Value)
End With
If objMatches.count > 0 Then
With TextBox124
strDDMM = Left(.Value, 2) & "/" & Mid(.Value, 3, 2) & "/"
If Len(.Value) = 6 Then ' user entered ddmmyy
If Val(Right(.Value, 2)) > 50 Then
strDDMM = strDDMM & "19"
Else
strDDMM = strDDMM & "20"
End If
.Value = strDDMM & Right(.Value, 2)
Else ' user entered ddmmyyyy
.Value = strDDMM & Right(.Value, 4)
End If
End With
Else ' user entered an invalid date
MsgBox "Data Invalida" & vbCrLf & _
"Favor utilizar um desses formatos de data:" & vbCrLf & _
"ddmmyy OU ddmmyyyy", vbOKOnly + vbCritical, _
"Erro ao inserir data"
Cancel = True
End If
End Sub
Any suggestions are welcome.
Thanks for your attention.
Final