Hajo- Anfrage zu vereinf. Uhrzeiteingabe
24.06.2005 11:44:21
Peter
ich habe auf Deiner Homepage dieses Makro gefunden.
Ist es möglich, die Eingabe so zu verändern, das den Sekunden bei der Eingabe automat. der Wert „0“ zugeordnet wird und nur noch Stunden und Minuten angezeigt werden?
Peter
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'* H. Ziplies *
'* 30.08.03 *
'* erstellt von Hajo.Ziplies@web.de *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
Dim RaBereich As Range, RaZelle As Range
Dim InS As Integer ' Variable für Stunden
Dim ByM As Byte ' Variable für Minuten
Dim BySe As Byte ' Variable für Sekunden
Dim ByZe As Byte ' Variable für Zehntel
Application.EnableEvents = False
' Bereich der Wirksamkeit
Set RaBereich = Range("C7:D50,C60,D60")
' ActiveSheet.Unprotect
For Each RaZelle In Range(Target.Address)
' überprüfen ob Zelle im vorgegebenen Bereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle <> "" Then
If RaZelle.Address <> "$C$60" And RaZelle.Address <> "$D$60" Then
RaZelle.Value = RaZelle.Value & "0" ' null ranhängen für zentel
End If
With Cells(RaZelle.Row, RaZelle.Column)
If IsNumeric(RaZelle.Value) Then
Select Case Len(RaZelle.Value)
Case 1
ByZe = RaZelle.Value
BySe = 0
ByM = 0
InS = 0
Case Is < 4
ByZe = Right(RaZelle, 1)
BySe = Mid(RaZelle.Value, 1, Len(RaZelle.Value) - 1)
ByM = 0
InS = 0
Case Is < 6
ByZe = Right(RaZelle, 1)
BySe = Mid(RaZelle, Len(RaZelle) - 2, 2)
ByM = Mid(RaZelle, 1, Len(RaZelle) - 3)
InS = 0
Case Is < 8
ByZe = Right(RaZelle, 1)
BySe = Mid(RaZelle, Len(RaZelle) - 2, 2)
ByM = Mid(RaZelle, Len(RaZelle) - 4, 2)
InS = Mid(RaZelle, 1, Len(RaZelle) - 5)
Case Else
MsgBox "Falsche eingabe"
End Select
.Value = InS & ":" & ByM & ":" & BySe & "." & ByZe
If RaZelle.Address <> "$C$60" And RaZelle.Address <> "$D$60" Then
.NumberFormat = "[hh]:mm:ss"
Else
.NumberFormat = "[hh]:mm:ss.0"
End If
End If
End With
End If
End If
Next RaZelle
Set RaBereich = Nothing
' ActiveSheet.Protect
Application.EnableEvents = True
End Sub