mein Code soll den Inhalt eines Textfeldes in einer Userform auf Gültigkeit überprüfen.
In diesem Textfeld darf nur ein Datum das größer ist als Heute eingetragen werden.
Ich muß ein workaround machen, da die Befehle Date und IsNumeric auf einigen Rechnern die mit bulgarischen Office-Versionen arbeiten nicht funktionieren.
Mein Code funktioniert an folgender Stelle nicht richtig, wenn man auch ein korrektes Datum eingibt erscheint die MsgBox:
'und damit unmögliche Jahresangaben wie 0007
' ElseIf Val(Right(Me.txtDatum, Len(Me.txtDatum) - InStrRev(Me.txtDatum, "."))) ' txtDatum = ""
' MsgBox "Hat wohl länger gedauert letzte Nacht,... noch nicht wach ?"
' Cancel = True
Mein gesamter Code:
Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
If Me.txtDatum "" Then
If Check_Date(Me.txtDatum) = False Then
MsgBox "Geben Sie ein gueltiges Datum ein"
txtDatum = ""
Cancel = True
ElseIf IsError(CDate(Me.txtDatum)) Then
MsgBox "Das ist kein gueltiges Datum"
txtDatum = ""
Cancel = True
'Datum kleiner ist,
ElseIf CDate(Me.txtDatum)
Function Check_Date(chkDate As String) As Boolean
Dim i As Byte
Dim tmp As String
'Nur damit es nachher kürzer zu schreiben ist :-)
tmp = chkDate
Select Case Len(tmp)
Case 10
'Format = 01.01.2007
'Prüfen ob Punkte richtig gesetzt sind
If Mid(tmp, 3, 1) = "." And Mid(tmp, 6, 1) = "." Then
'Monatsprüfun
Select Case Val(Mid(tmp, 4, 2))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
End Select
End If
Case 9
'Format = 1.09.2007 oder 15.1.2007
'Prüfen ob Punkte richtig gesetzt sind
If Mid(tmp, 2, 1) = "." And Mid(tmp, 5, 1) = "." Then
'Monatsprüfung
Select Case Val(Mid(tmp, 3, 2))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
End Select
End If
If Mid(tmp, 3, 1) = "." And Mid(tmp, 5, 1) = "." Then
'Monatsprüfung
Select Case Val(Mid(tmp, 4, 2))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
End Select
End If
Case 8
'Format = 1.1.2007
'Prüfen ob Punkte richtig gesetzt sind
If Mid(tmp, 3, 1) = "." And Mid(tmp, 6, 1) = "." Then
'Monatsprüfung
Debug.Print Val(Mid(tmp, 4, 2))
Select Case Val(Mid(tmp, 4, 2))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
End Select
End If
Case 6
'Format = 1.1.07
'Prüfen ob Punkte richtig gesetzt sind
If Mid(tmp, 2, 1) = "." And Mid(tmp, 4, 1) = "." Then
'Monatsprüfung
Select Case Val(Mid(tmp, 3, 1))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2))
Check_Date = True
Exit Function
End If
End Select
End If
Case Else
Check_Date = False
End Select
End Function
Kann mir jemand helfen?
Danke im Voraus
Grüße aus Berlin