Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

KORREKTUR
Autor: PsychoForest
Datum: 19.12.01 12:21
Hallo Dieter, ich hab' mir aus den Tips&Tricks die Routine zum prüfen auf gültige Datumseingaben zu Hilfe genommen. Vieleicht ist es ja interessant, daß ein paar Änderunge notwendig sind. Probier einfach mal den 31.12.01 abzufragen. u.a. hat die Routine auch völlig blödsinnige Eingaben akzeptiert. Mein aktueller Stand: ' Datum aus Plausibilität prüfen ' Rückgabewert: formatierte Datumsangabe oder Leerstring, ' wenn ungültiges Datum (Thomas Steinl) 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 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)) 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) ' 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 ' Tag prüfen (Bereich 1-31) If TT > 0 And TT < 32 Then ' Monat prüfen (Bereich 1-12) If MM > 0 And MM < 13 Then ' 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 ' wenn Tag größer als maximale Anzahl Tage ' im angegeben Monat If TT > Day(DateSerial(JJ, MM + 1, 1) - 1) Then ' Tagesangabe korrigieren TT = Day(DateSerial(JJ, MM + 1, 1) - 1) End If Result = True End If End If If Result Then ' wenn alles OK - Datum formatieren ' tt.mm.jjjj Datum = Format$(DateSerial(JJ, MM, TT), _ "dd.mm.yyyy") End If End If Else Result = True Datum = "" End If If Result = False Then CheckDatum = "00.00.00" Else CheckDatum = Datum End If End Function bye Forest

KORREKTUR

62

PsychoForest

19.12.01 12:21

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