'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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen