Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Tipp nicht ganz sauber
Autor: Rainer
Datum: 17.09.02 14:38
Hallo Dieter, der Tip Datumseingaben auf Plausibilität prüfen ist nicht ganz in Ordnung! So soll die Function bei Fehlerhaften Datum bzw ungültigen Datum ein "" zurückliefern, was sie aber nicht macht! Sie liefert das ungültige Datum zurück! Jedenfalls wenn man keine Punkte eingegeben hat! Außerdem wird immer nur bei den Tagen geprüft ab sie größer 0 und kleiner 32 sind, was bei einigen Monaten auch nicht richtig passt! Gebe ich den 31.02.01 ein wird dies akzeptiert! Ich habe mich mal ein bißchen damit beschäftigt und habe die Function so umgeschrieben (Vielleicht könntest du die ja so aufnehmen bzw die andere ändern ' Datum auf Plausibilität prüfen ' Rückgabewert: formatierte Datumsangabe oder Leerstring, ' wenn ungültiges Datum Public Function CheckDatum(ByVal Datum As String) As String Dim Result As Boolean Dim TT As Integer Dim MM As Integer Dim JJ As Integer Dim sPos As Integer Dim Entry As String Dim Helper As Integer On Error GoTo Hell Result = False ' Ist überhaupt ein Datum eingetragen? If Trim(Datum) <> ". ." And Datum <> "" Then ' keine Punkte im Datum vorhanden If InStr(Datum, ".") = 0 Then ' Eingabelänge mindestens 4-stellig If Len(Datum) > 3 Then TT = Val(Left(Datum, 2)) MM = Val(Mid(Datum, 3, 2)) If Trim(Mid(Datum, 5)) = "" Then ' Jahresangabe fehlt -> aktuelles Jahr annehmen JJ = Val(Right(Date, 4)) Else JJ = Val(Mid(Datum, 5, 4)) End If Result = True End If Else ' Eingabe enthält Punktangaben Entry = Datum ' Tag ermitteln sPos = InStr(Entry, ".") TT = Val(Left(Entry, sPos - 1)) Entry = Mid(Entry, sPos + 1) ' Monat ermitteln sPos = InStr(Entry, ".") If sPos Then MM = Val(Left(Entry, sPos - 1)) Entry = Mid(Entry, sPos + 1, 4) ' keine Jahresangabe -> aktuelles Jahr annehmen If Trim(Entry) = "" Then Entry = Right(Date, 4) End If JJ = Val(Entry) Result = True End If End If If Result Then Result = False ' wenn Jahresangabe zweistellig If JJ < 100 Then ' wenn kleiner 30 If JJ < 30 Then ' Jahr 2000 annehmen JJ = 2000 + JJ Else ' Jahr 1900 annehmen JJ = 1900 + JJ End If End If If MM > 0 And MM < 13 Then Helper = Day(DateAdd("m", 1, "01." & MM & "." & JJ) - 1) If TT > 0 And TT <= Helper Then Result = True Else Result = False End If Else Result = False End If If Result Then ' wenn alles OK - Datum formatieren ' tt.mm.jjjj Datum = Format(DateSerial(JJ, MM, TT), "dd.mm.yyyy") Else Datum = "" End If End If End If CheckDatum = Datum Exit Function Hell: If Err.Number <> 0 Then Exit Function End Function

Tipp nicht ganz sauber	165	Rainer	17.09.02 14:38
Re: Tipp nicht ganz sauber	339	Dieter	17.09.02 20:44
Re: Tipp nicht ganz sauber	303	unbekannt	17.09.02 20:54
Re: Tipp nicht ganz sauber	87	Rainer	17.09.02 22:23

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen