Hallo,
ich habe eine Teillösung erarbeitet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngValue As Long
Dim lngMs As Long, lngSec As Long, lngMin As Long, lngHour As Long
Dim rngTime As Range
'Set rngtime = Range(ThisWorkbook.Names("Uhrzeiten").RefersTo)
Set rngTime = Intersect(Range(ThisWorkbook.Names("Uhrzeiten").RefersTo), Target)
If Not rngTime Is Nothing Then
lngValue = rngTime.Value
Debug.Print lngValue
lngMs = lngValue - (Int(lngValue / 1000) * 1000)
lngValue = (lngValue - lngMs) / 1000
lngSec = lngValue - (Int(lngValue / 100) * 100)
lngValue = (lngValue - lngSec) / 100
lngMin = lngValue - (Int(lngValue / 100) * 100)
lngValue = (lngValue - lngMin) / 100
lngHour = lngValue
'Debug.Print lngHour & ":" & lngMin & ":" & lngSec & "," & lngMs
Application.EnableEvents = False
With rngTime
.Formula = TimeSerial(lngHour, lngMin, lngSec + (lngMs / 1000))
.NumberFormat = "[h]:mm:ss.000"
End With
Application.EnableEvents = True
End If
End Sub
-------------------------
Was macht dieser Code?
Zuerst muss ein Namenseintrag "Uhrzeiten" festgelegt werden, in dem die Zellen festgelegt werden, in denen die Eingabe in eine Uhrzeit umgewandelt werden sollen.
Anschließend werden alle Eingaben im festgelegten Bereich in eine Uhrzeit umgewandelt, nachdem eine Eingabe erfolgt ist.
-----------------------
Dieser Code muss dem Tabellenblatt zugewiesen werden. (Über den VBA-Editor / Tabelle anklicken und den Code anzeigen lassen)
Teillösung daher, weil die Anzeige der Millisekunden noch nicht gelingen will.
Statt der Millisekunden wird immer 000 angezeigt.
Vielleicht weiß jemand anders jhier eine Lösung?
LG, BigBen
|