Automatisch nullen plaatsen bij urenregistratie

Hallo,

Ik heb een bestand gemaakt voor het registreren van uren. Hiervoor heb ik ondermeer onderstaande code voor gebruikt. Deze code plaatst automatisch een dubbele punt bij het invoeren van de uren. Echter, nu vroeg ik me af of het mogelijk is om bij het invoeren van hele uren, automatisch twee nullen te laten plaatsten. Dus wanneer begintijd 8:00 uur is, dat je alleen maar 8 hoeft te typen.


Private Sub Worksheet_Change(ByVal target As Range)
'invoeren van tijd in gehele getallen

On Error Resume Next
If Intersect(target, Range("E1:F2200")) Is Nothing Then GoTo Einde
If IsEmpty(target) Then GoTo Einde

If Hour(target.Value) <> 0 Or Minute(target.Value) <> 0 Then GoTo Einde
Application.EnableEvents = False
If Int(target.Value / 100) < 0.1 Then
target = "00:" & target.Value
Else
target = Int(target.Value / 100) & ":" & Right(target.Value, 2)
End If
Application.EnableEvents = True

Einde:
ActiveSheet.Calculate
End Sub

Alvast bedankt!

Feijtert,
Met uw code is er niets mis. Om 8:00 te bekomen geeft ge 800 in.

Ja, maar dat bedoel ik ook niet. Mijn vraag was of het mogelijk is de nullen niet te moeten typen. Dus dat ik alleen een 8 hoef te typen bij het ingeven van 8:00 uur.

Vraag opgelost

Ik heb de oplossing al gevonden:

Private Sub Worksheet_Change(ByVal target As Range)
'invoeren van tijd in gehele getallen

On Error Resume Next
If Not (Intersect(target, Range("E1:F2200")) Is Nothing) Then
If Not (IsEmpty(target)) Then
If Not (Hour(target.Value) <> 0 Or Minute(target.Value) <> 0) Then
Application.EnableEvents = False
If target.Value >= 24 Then
target = Int(target.Value / 100) & ":" & Right(target.Value, 2)
Else
target = target.Value & ":00"
End If
Application.EnableEvents = True
ActiveSheet.Calculate
End If
End If
End If
On Error GoTo 0
End Sub