Private Sub TextBox6_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' erstellt von Hajo.ziplies@web.de Stand 02.02.04
' 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 TextBox6.Tag = "1" = True Then Exit Sub
If Len(TextBox6) = 2 Then
If InStr(TextBox6, ".") = 0 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()
TextBox6.Tag = 1
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
TextBox6.Tag = ""
End Sub
Private Sub TextBox8_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' erstellt von Hajo.ziplies@web.de Stand 02.02.04
' http://home.media-n.de/ziplies/
' Eingabe Uhrzeit die Doppelunkte automatisch gesetzt
' sie können nur gelöscht durch markierung des punktes und der Zahl davor
' Buchstaben werden ausgeschlossen, nur Zahlen und Doppelunkt
' die Überprüfung ob Uhrzeit erfolgt in
Private Sub TextBox8_AfterUpdate()
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Asc(":")
If Len(TextBox8) = 0 Then
KeyAscii = 0
Else
' Prüfen obe mehr als 2 x :
If Len(TextBox8) - Len(Application.Substitute(TextBox8, ":", "")) = 2 Then
KeyAscii = 0
' Prüfen das : nicht an Stelle1
ElseIf Len(TextBox8) > 1 Then
' Prüfen ob letztes Zeichen
If Mid(TextBox8, Len(TextBox8), 1) = ":" Then KeyAscii = 0
Else
KeyAscii = Asc(".")
End If
End If
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub TextBox8_Change()
If TextBox8.Tag = "1" Then Exit Sub
If Len(TextBox8) = 2 Then
If InStr(TextBox8, ":") = 0 Then TextBox8 = TextBox8 & ":"
ElseIf Len(TextBox8) = 5 Then
If Len(TextBox8) - Len(Application.Substitute(TextBox8, ":", "")) < 2 Then
TextBox8 = TextBox8 & ":"
End If
End If
End Sub
Private Sub TextBox8_AfterUpdate()
TextBox8.Tag = 1
If Right(TextBox8, 1) = ":" Then TextBox8 = Mid(TextBox8, 1, Len(TextBox8) - 1)
If IsDate(TextBox8.Text) Then
If Format(CDate(TextBox8.Value), "hh:mm:ss") <> TextBox8 Then
MsgBox "Das Datum wurde übersetzt"
End If
TextBox8 = Format(CDate(TextBox8.Value), "hh:mm:ss")
Else
TextBox8 = ""
End If
TextBox8.Tag = ""
End Sub
Gruß Hajo