Macro: Tijd aanpassen in bepaalde cellen.

[Yasmin]

Ik heb een werkblad met een macro waar ingevoerde tijd geconverteerd wordt naar het juiste tijdformaat.
b.v. invoer in cel A1 700 wordt 7:00.
Dit macro (zie onder) geldt voor heel het werkblad.
Is het ook mogelijk om het macro zo aan te passen dat het werkt op een enkele vooraf te bepalen cel, dus eigenlijk een aangepaste celeigenschap?


Private Sub Worksheet_Change(ByVal rng As Range)

If IsEmpty(rng) Then Exit Sub


Application.EnableEvents = False


ingave = rng.Value
If Hour(ingave) <> 0 Or Minute(ingave) <> 0 Then Exit Sub
If Int(ingave / 100) < 0.1 Then
rng = "00:" & ingave
Else
rng = Int(ingave / 100) & ":" & Right(ingave, 2)
End If

Application.EnableEvents = True
End Sub

Wie kan me hierbij helpen?

Vr.gr. André

 

[jzeedijk]

Hoi Andre,

If not intersect(rng,Union(Range("B4"),Range("K11:M27"))) is nothing then
If IsEmpty(rng) Then Exit Sub
....
End If
End If

Jeroen

 

[jpvs]

Dit is alleen voor kolom A

Private Sub Worksheet_Change(ByVal rng As Range)
If Intersect(rng, Range("A:A")) Is Nothing Then Exit Sub
On Error GoTo klaar
ingave = rng.Value
If Hour(ingave) <> 0 Or Minute(ingave) <> 0 Then Exit Sub
If Int(ingave / 100) < 0.1 Then
rng = "00:" & ingave
Else
rng = Int(ingave / 100) & ":" & Right(ingave, 2)
End If
klaar:
End Sub


Pierre

 

[jpvs]

Dit heb ik ook gevonden, maar werkt niet alleen met minuten??? of doe ik iets verkeerd?
Vb 1400 zou 14:00 moeten worden?
en dit gaat niet

Zet deze code in ThisWorkbook en het werkt voor alle tabbladeren.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)

'---------------------------------------------------------------------------
-----------------------------------------------------------
'Deze code wordt uitgevoerd indien er in één van de werkbladen in het
werkboek in de reeks B2 t/m G10 een getal wordt ingevoerd.
'Dit getal wordt omgezet naar een tijdstip, zodoende hoeft er geen ":"
meer te worden ingevoerd.
'tevens zitten er een aantal simpele controles in op de ingevoerde
waardes.
'Met dank aan o.a. PeterS & Ingrid Baplue

'---------------------------------------------------------------------------
-----------------------------------------------------------
On Error GoTo Klaar
Gevonden = "Nee"
Gevonden1 = "Nee"
ingave = Source.Value
Gebied = Source.Address

Max = Len(Gebied)
Teller = 1
Teller1 = 1

Do While Gevonden = "Nee" And Teller < Max
teken = Mid(Gebied, Teller, 1)
If teken = ":" Then
Gevonden = "Ja"
Exit Do
Else
Teller = Teller + 1
End If
Loop
If Gevonden = "Ja" Then Exit Sub 'GoTo Klaar

Do While Gevonden1 = "Nee" And Teller1 < 5
Teken1 = Mid(ingave, Teller1, 1)
If Teken1 = "," Or Teken1 = "." Or Teken1 = ";" Then
Gevonden1 = "Ja"
Exit Do
Else
Teller1 = Teller1 + 1
End If
Loop

If Gevonden1 = "Ja" Then
Source.Value = ""
MsgBox "U hebt een '" & Teken1 & "' ingegeven! Dit mag/hoeft niet!" &
Chr(10) & Chr(13) & "Verbeter s.v.p. uw invoer.", , "Foutieve invoer"
Source.Select
Exit Sub
End If

Set isect = Application.Intersect(Source, Range("B2:G10"))
If Source.Value = "" Then Exit Sub 'GoTo Klaar

If isect Is Nothing Then
Source.Value = ""
MsgBox "In dit gebied niets invoeren!"
Source.Select
Exit Sub
Else
'start code voor het bereik B2:G10

If Hour(ingave) <> 0 Or Minute(ingave) <> 0 Then
Exit Sub
ElseIf Right(ingave, 2) >= 60 Then
Source.Value = ""
MsgBox Right(ingave, 2) & " minuten (minuten)?? Dat kan toch
niet!"
Source.Select
GoTo Klaar
ElseIf Len(ingave) = 4 And Left(ingave, 2) > 23 Then
Source.Value = ""
MsgBox Left(ingave, 2) & " uur?? Dat kan toch niet!"
Source.Select
GoTo Klaar
ElseIf Int(ingave / 100) < 0.1 Then
Application.EnableEvents = False
Source.Value = "00:" & ingave
Else
Source.Value = Int(ingave / 100) & ":" & Right(ingave, 2)
GoTo Klaar
End If
End If
Klaar:
Application.EnableEvents = True
End Sub

 

[Yasmin]

Bedankt Jeroen en Pierre,


het werkt!

vr.gr. André