Hallo Nick,

Option Explicit
Dim BoEnter As Boolean

Private Sub TextBox6_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' erstellt von ^*xxxxxxxxx*@web.de Stand 01.08.03
' Datumseingabe 01.01.03;1.1.03 oder komlettes Jahr
' Eingabe des Tages und des Monat zweistellig werden die Punkte automatisch gesetzt
' sie können nur gelöscht durch markierung des punktes und der Zahl davor
' Buchstaben werden ausgeschlossen, nur Zahlen und Punkt
' die Überprüfung ob Datum erfolgt in Private Sub TextBox6_AfterUpdate()
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Asc(".")
If Len(TextBox6) = 0 Then
KeyAscii = 0
Else
If Len(TextBox6) - Len(Application.Substitute(TextBox6, ".", "")) = 2 Then
KeyAscii = 0
ElseIf Len(TextBox6) > 1 Then
If Mid(TextBox6, Len(TextBox6), 1) = "." Then KeyAscii = 0
Else
KeyAscii = Asc(".")
End If
End If
Case Else
KeyAscii = 0
End Select
End Sub

Private Sub TextBox6_Change()
If BoEnter = True Then Exit Sub
If Len(TextBox6) = 2 Then
If InStr(TextBox6, ".") = 0 And BoEnter = False Then TextBox6 = TextBox6 & "."
ElseIf Len(TextBox6) = 5 Then
If Len(TextBox6) - Len(Application.Substitute(TextBox6, ".", "")) < 2 Then
TextBox6 = TextBox6 & "."
End If
End If
End Sub

Private Sub TextBox6_AfterUpdate()
BoEnter = True
If Right(TextBox6, 1) = "." Then TextBox6 = Mid(TextBox6, 1, Len(TextBox6) - 1)
' Jahreszahl vom aktuellen Jahr ergänzen falls nicht vorhanden
If Len(TextBox6) - Len(Application.Substitute(TextBox6, ".", "")) = 1 Then
TextBox6 = TextBox6 & "." & Year(Date)
End If
If IsDate(TextBox6.Text) Then
If Format(CDate(TextBox6.Value), "dd.mm.yy") <> TextBox6 Then
MsgBox "Das Datum wurde übersetzt"
End If
TextBox6 = Format(CDate(TextBox6.Value), "dd.mm.yy")
Else
TextBox6 = ""
End If
BoEnter = False
End Sub

Gruß hajo

^{*Threadedit* 30.06.2009, 19:24:30
Admininfo: Persönliche Daten gelöscht, siehe FAQ 5, #5}