Kontakt
DSVGO
Public Function DateFormat( _ ByVal Datum As String, _ Optional Formatierung As String = "dd.mm.yyyy" _ ) As String 'Deklarationen: Dim Tag As Long Dim Monat As Long Dim Jahr As Long Dim i As Long 'Datum trimmen: Datum = Trim$(Datum) If Datum = "" Then Exit Function 'Format normieren: Datum = Replace(Trim$(Datum), ":", ".") Datum = Replace(Trim$(Datum), ",", ".") 'Tag: i = InStr(Datum, ".") If i Then Tag = Val(Left$(Datum, i - 1)) Datum = Mid$(Datum, i + 1) Else Tag = Val(Left$(Datum, 2)) Datum = Mid$(Datum, 3) End If If Tag = 0 Then Exit Function 'Monat: i = InStr(Datum, ".") If i Then Monat = Val(Left$(Datum, i - 1)) Datum = Mid$(Datum, i + 1) Else Monat = Val(Left$(Datum, 2)) Datum = Mid$(Datum, 3) End If If Monat = 0 Then 'Aktuellen Monat berücksichtigen: Monat = Month(Now) If Tag < Day(Now) Then Monat = Monat + 1 End If 'Jahr: Jahr = Val(Datum) If Jahr = 0 Then 'Aktuelles Jahr berücksichtigen: Jahr = Year(Now) If DateSerial(Jahr, Monat, Tag) < Now Then Jahr = Jahr + 1 ElseIf Jahr < 100 Then 'Aktuelles Jahrhundert berücksichtigen: Jahr = (Year(Now) \ 100) * 100 + Jahr End If On Error Resume Next DateFormat = Format$(DateSerial(Jahr, Monat, Tag), Formatierung) End FunctionÜbrigens: Benutzen Sie die schnelle Replace-Funktion, falls Sie noch mit einer VB-Version kleiner als 6 arbeiten.
Private Sub txtDatum_LostFocus() Dim Datum As String Datum = DateFormat(txtDatum.Text) If Datum <> txtDatum.Text Then 'Datum wurde umformatiert: If Len(Datum) Then 'Datum war korrekt: txtDatum.Text = Datum Else 'Datum ist fehlerhaft: Beep txtDatum.SetFocus End If End If End Sub
© Jost Schwider, 12.08.2000-12.08.2000 - http://vb-tec.de/datefrmt.htm