Tijdschema VBA (MS project like)

Status
Niet open voor verdere reacties.
R

radho93

Nieuwe gebruiker
Lid geworden
2 jan 2015
Berichten
1
Goedemorgen allemaal,

Ik ben gister aan het stoeien geweest met een VBA code.
Het gaat om het volgende:
Ik wil graag een stukje code schrijven met behulp van een UserForm om een soort tijdschema te creëren.
Er moet dus een begintijd worden ingegeven, een eindtijd en een interval om zo een soort tijdlijn te maken.

Nou ben ik met een aantal uur puzzelen op het volgende gekomen (zie bijlage).
Het is me gelukt om een soort van tijdlijn te laten maken, maar het is nog niet helemaal zoals ik het wil.
Ik zou het graag met echt een tijdsaanduiding (9:30 ipv 9,5) willen laten tonen. Ook wil ik dus het interval in seconden kunnen laten weergeven. Dus stel dat er voor 30 seconden wordt gekozen, dat het dus 9:30:00 is en de volgende 9:30:30 enz. Ik zat te denken dat dit misschien mogelijk is met een "While" loop, maar ik kom er niet uit.

Zou iemand mij hiermee kunnen helpen?

Mvg

Bekijk bijlage 1daySChedule.xlsm
 
kijk eens of je hier verder mee komt
Code: 
TimeStart = CDate(UserForm1.TimeStart.Value)
TimeEnd = CDate(UserForm1.TimeEnd.Value)
interval = Val(UserForm1.TimeInterval.Value)

scalex = interval * 60 * 24
t = scalex / 86400 / 60 / 24


For i = TimeStart To TimeEnd Step t
Worksheets(2).Cells(20, 2 + x) = Format(i, "hh:mm:ss")
x = x + 1
Next
 
Dit bestand verder uitgewerkt met 4 Optionbuttons, met 3 hiervan heb je de keuze om of sec of min of uur getallen in te vullen
en als laatste nog een Optionbutton om gewoon een tijdwaarde in te vullen
Mocht de interval tijd boven de eindtijd uitkomen dan wordt tot de laatste intervaltijd op het blad weergegeven.
Als intervaltijd gelijk met eindtijd eindigd dan wordt ook de eindtijd op het blad weergegeven
 

Bijlagen

  • 1daySChedule.rar
    58,9 KB · Weergaven: 135
Laatst bewerkt:
Toch wat vergeten :(
Had geen rekening gehouden als Starttijd hoger zou zijn als Eindtijd
Deze doet dat wel
Code: 
Private Sub CreateScale_Click()

Dim TimeStart As Double, TimeEnd As Double, t As Double

TimeStart = CDate(UserForm1.TimeStart.Value)
TimeEnd = CDate(UserForm1.TimeEnd.Value)

 Select Case True
    Case OptionButton1.Value
     t = CDate(UserForm1.TimeInterval.Value)                              'Er moet een juiste tijd waarde ingevuld zijn
    Case OptionButton2.Value
     t = Val(UserForm1.TimeInterval.Value) * 86400 / 86400 / 60 / 60 / 24 'maak er seconden van
    Case OptionButton3.Value
     t = Val(UserForm1.TimeInterval.Value) * 86400 / 86400 / 60 / 24      'maak er minuten van
    Case OptionButton4.Value
     t = Val(UserForm1.TimeInterval.Value) * 86400 / 86400 / 24           'maak er uren van
 End Select
 
t_Start = IIf(TimeStart > TimeEnd, Date & " " & CDate(TimeStart), TimeStart)
t_Eind = IIf(TimeStart > TimeEnd, Date + 1 & " " & CDate(TimeEnd), TimeEnd)

With Worksheets("Sheet2")
 .Range(.Cells(1, 1), .Cells(100, 100)).ClearContents

   For i = CDate(t_Start) To CDate(t_Eind) Step t
    .Cells(20, 2 + x) = Format(i, "hh:mm:ss")
    x = x + 1
   Next
   
   If CStr(CDate(Format(.Cells(20, 2 + x - 1), "hh:mm:ss")) + CDate(Format(t, "hh:mm:ss"))) = CStr(CDate(Format(TimeEnd, "hh:mm:ss"))) Then
    .Cells(20, 2 + x) = Format(TimeEnd, "hh:mm:ss")
   End If
  
End With

Application.Goto Worksheets("Sheet2").Cells(20, 1)
Columns("A:ZZ").ColumnWidth = 15
ActiveWindow.Zoom = 75
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan