'Userform
Option Explicit
Private Sub CommandButton1_Click()
If DatOK(Me.TextBox1.Text, 4) = False Then
Me.TextBox1.Text = ""
MsgBox "Keine Richtige Datumseingabe !", vbCritical, "Bitte ändern !!!"
End If
End Sub
'Allgemeines Modul
Option Explicit
Public Function DatOK(varWert As Variant, Stellen_Jahr As Integer) As Boolean
'Eingabeformat 16.11.05 / TT.MM.JJ = DD.MM.YY = Stellen_Jahr 2
'Eingabeformat 16.11.2005 / TT.MM.JJJJ = DD.MM.YYYY = Stellen_Jahr 4
Dim intlen As Integer, intMon As Integer, intDay As Integer, intYear As Integer
Select Case Stellen_Jahr
Case 2: intlen = 8
Case 4: intlen = 10
End Select
If Len(varWert) > intlen Or Len(varWert) < intlen Then _
GoTo FalschesDatum
If Mid(varWert, 3, 1) <> "." Or Mid(varWert, 6, 1) <> "." Then _
GoTo FalschesDatum
intMon = Mid(varWert, 4, 2) * 1
intDay = Left(varWert, 2) * 1
If Not IsNumeric(intDay) Or Not IsNumeric(intMon) _
Then GoTo FalschesDatum
If Stellen_Jahr = 2 Then
intYear = ("20" & Right(varWert, 2)) * 1
If Not IsNumeric(intYear) Then _
GoTo FalschesDatum
ElseIf Stellen_Jahr = 4 Then
intYear = Right(varWert, 4) * 1
If Not IsNumeric(intYear) Then _
GoTo FalschesDatum
End If
Select Case intMon
Case 1, 3, 5, 7, 8, 10, 12
If intDay > 31 Then _
GoTo FalschesDatum
Case 4, 6, 9, 11
If intDay > 30 Then _
GoTo FalschesDatum
Case 2
If intDay > 28 Then
If Month(DateSerial(intYear, intMon, intDay)) <> intMon Then _
GoTo FalschesDatum
End If
Case Else
GoTo FalschesDatum
End Select
DatOK = True
Exit Function
FalschesDatum:
DatOK = False
End Function