Zeitangabemakro einbinden
17.07.2003 22:23:44
Christof
Gruß Christof
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 4 Then Exit Sub
If merker = True Then
merker = False
Exit Sub
End If
merker = False
fehler = False
'Sonderfall 24:00 oder 00:00
If Target = 1 Or Target = 0 Then
' merker = True
Target.NumberFormat = "h:mm"
Exit Sub
End If
'Abfangen von Eingaben wie 12:34
'sie ergeben in der Zelle 00:00
If Target < 1 Then
Var = Format(Target, "hh:mm")
If Var = "00:00" Then
fehler = True
GoTo marke
End If
End If
'Abfangen von Eingaben wie 'Abfangen von Eingaben wie 56:78
If InStr(1, Var, ":", vbTextCompare) > 0 Then
If Len(Var) <> 5 Then fehler = True
std = Left(Var, 2)
If std >= 24 Then fehler = True
Min = Right(Var, 2)
If Min >= 60 Then fehler = True
GoTo marke
End If
lg = Len(Target)
If lg = 2 Then
std = "00"
Min = Target
If Min >= 60 Then fehler = True
ElseIf lg = 3 Or lg = 4 Then
std = Left(Target, lg - 2)
If std > 24 Then fehler = True
Min = Right(Target, 2)
If Min >= 60 Then fehler = True
ElseIf lg > 4 Then
fehler = True
End If
marke:
If fehler = True Then
Target.Select
MsgBox "keine korrekte Zeitangabe"
merker = True
Target.ClearContents
Else
merker = True
'Sonderfall
If Target = "2400" Then
merker = True
Target.Value = "00:00"
Else
merker = True
Target.Value = Format(std & ":" & Min, "hh:mm")
End If
End If
End Sub