T
Tony Strazzeri
Hi Everyone,
I have a need support data entry of a time. My client wants all times
entered to be rounded to the nearest 15 minutes. I thought it would be
useful to use the DateTimePicker control to do this since it allows
for 12 and 24 hr clock values and can format the output with or
without AM/PM indicators. I was already using it on the form to input
some dates.
It seemed like a good idea at the time! <g>
I came across two basic problems with this control.
1. I want the control to display empty until a time is actually keyed
in. This was quite hard to do and after much searching came across a
method that does this quite elegantly. I post this solution here for
general information.
To display an empty value for a DateTimePicker control
Const Time_Null_Marker_Format="'" 'Note:That is two single quotes
within the two double quotes
DTPicker1.Format = dtpCustom
DTPicker1.CustomFormat = Time_Null_Marker_Format
Note this does not change the value of the control just the display.
Knowing this, I set the format to something else in the control's
Enter event so that if I want to know if the control hasn't yet been
edited I can test for DTPicker1.CustomFormat = Time_Null_Marker_Format
Now the problem I can's solve.
2. How to round the time entered to the nearest 15 minutes.
This is where I have noticed some strange (for me anyway) behaviour.
I thought it would be a simple matter of putting some code in the
BeforeUpdate, AfterUpdate or Exit event for the control. I have even
tried the Change event.
The problem is that the events do not behave in a way a can use.
Neither the BeforeUpdate or AfterUpdate events seem to fire.
The Change event will fire as you change from parts of the control
(say from hour to minutes) but it doesn't do so immediately. I can
understand this in the case of entering a single digit value (it
pauses briefly and unless another digit is entered it accepts the
single digit value) but is still seems to pause after the second
digit.
The Exit event fires if you click the UpDown arrows of the control.
Any insight into how to make this work would be appreciated.
Cheers
Happy Christmas and Other Festivities,
TonyS.
Do the following to produce a working form to see this in action.
Create a form.
To be able to create the control you need to display the VBA toolbox
and right click somewhere on the toolbox. Select "Additional
Controls" from the context menu that is displayed.
Scroll through the Additional Controls list (make sure the Show
"Selected Items Only" checkbox is unchecked)
to bring up the "Microsoft Date Time Picker Control 6.0 (SP4)" (the
file this is is in is MSCOMCT2.OCX )
Select the Checkbox beside the listing.
Now Place a textbox (or any other control that can receive focus when
you exit the dtp) and one DateTimePicker control onto the form.
Paste the following code into the UserForm's general section then run
the form.
if you put breakpoints on the BeforeUpdate or AfterUpdate events you
can see that they don't fire.
Try changing the minutes by entering a value by keyboard. You will
see that if you quickly tan out of the control, the value is not
rounded.
Also see the note in the Change event.
Private Sub DTPicker_AfterUpdate()
DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub
Private Sub DTPicker_BeforeUpdate(ByVal Cancel As
MSForms.ReturnBoolean)
DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub
Private Sub DTPicker_Change()
'If this is enabled then you can't change the time using the
'updown arrows because each change is rounded to nearest 15
'interestingly you can change down which causes the hours to
decrement
DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub
Private Sub DTPicker_Exit(ByVal Cancel As MSForms.ReturnBoolean)
DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub
Private Sub UserForm_Activate()
With DTPicker
.Format = dtpCustom
.CustomFormat = "h:mm tt"
.UpDown = True
End With
End Sub
Function RoundTimeTo(TargetDateTime As String, RoundingInterval As
Integer) As String
'Please ignore the clumsiness of this procedure. I was tired and
it was late.!
Dim CurrMinute
Dim Num
Dim hrs
Dim difr
Dim wrk
Dim adjustment
Dim remainder
Dim TimeInMinutes
Dim wrkDate As Date
wrkDate = CDate(TargetDateTime)
hrs = Hour(wrkDate)
CurrMinute = Minute(CDate(TargetDateTime))
TimeInMinutes = (hrs * 60) + CurrMinute
remainder = TimeInMinutes Mod RoundingInterval
If remainder < RoundingInterval / 2 Then
adjustment = -remainder
ElseIf remainder > RoundingInterval / 2 Then
adjustment = RoundingInterval - remainder
Else
adjustment = 0
End If
wrk = (hrs * 60) + CurrMinute + adjustment
Dim dt As Date
dt = DateSerial(Year(TargetDateTime), Month(TargetDateTime),
Day(TargetDateTime))
wrk = DateAdd("n", wrk, dt)
RoundTimeTo = wrk
End Function
I have a need support data entry of a time. My client wants all times
entered to be rounded to the nearest 15 minutes. I thought it would be
useful to use the DateTimePicker control to do this since it allows
for 12 and 24 hr clock values and can format the output with or
without AM/PM indicators. I was already using it on the form to input
some dates.
It seemed like a good idea at the time! <g>
I came across two basic problems with this control.
1. I want the control to display empty until a time is actually keyed
in. This was quite hard to do and after much searching came across a
method that does this quite elegantly. I post this solution here for
general information.
To display an empty value for a DateTimePicker control
Const Time_Null_Marker_Format="'" 'Note:That is two single quotes
within the two double quotes
DTPicker1.Format = dtpCustom
DTPicker1.CustomFormat = Time_Null_Marker_Format
Note this does not change the value of the control just the display.
Knowing this, I set the format to something else in the control's
Enter event so that if I want to know if the control hasn't yet been
edited I can test for DTPicker1.CustomFormat = Time_Null_Marker_Format
Now the problem I can's solve.
2. How to round the time entered to the nearest 15 minutes.
This is where I have noticed some strange (for me anyway) behaviour.
I thought it would be a simple matter of putting some code in the
BeforeUpdate, AfterUpdate or Exit event for the control. I have even
tried the Change event.
The problem is that the events do not behave in a way a can use.
Neither the BeforeUpdate or AfterUpdate events seem to fire.
The Change event will fire as you change from parts of the control
(say from hour to minutes) but it doesn't do so immediately. I can
understand this in the case of entering a single digit value (it
pauses briefly and unless another digit is entered it accepts the
single digit value) but is still seems to pause after the second
digit.
The Exit event fires if you click the UpDown arrows of the control.
Any insight into how to make this work would be appreciated.
Cheers
Happy Christmas and Other Festivities,
TonyS.
Do the following to produce a working form to see this in action.
Create a form.
To be able to create the control you need to display the VBA toolbox
and right click somewhere on the toolbox. Select "Additional
Controls" from the context menu that is displayed.
Scroll through the Additional Controls list (make sure the Show
"Selected Items Only" checkbox is unchecked)
to bring up the "Microsoft Date Time Picker Control 6.0 (SP4)" (the
file this is is in is MSCOMCT2.OCX )
Select the Checkbox beside the listing.
Now Place a textbox (or any other control that can receive focus when
you exit the dtp) and one DateTimePicker control onto the form.
Paste the following code into the UserForm's general section then run
the form.
if you put breakpoints on the BeforeUpdate or AfterUpdate events you
can see that they don't fire.
Try changing the minutes by entering a value by keyboard. You will
see that if you quickly tan out of the control, the value is not
rounded.
Also see the note in the Change event.
Private Sub DTPicker_AfterUpdate()
DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub
Private Sub DTPicker_BeforeUpdate(ByVal Cancel As
MSForms.ReturnBoolean)
DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub
Private Sub DTPicker_Change()
'If this is enabled then you can't change the time using the
'updown arrows because each change is rounded to nearest 15
'interestingly you can change down which causes the hours to
decrement
DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub
Private Sub DTPicker_Exit(ByVal Cancel As MSForms.ReturnBoolean)
DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub
Private Sub UserForm_Activate()
With DTPicker
.Format = dtpCustom
.CustomFormat = "h:mm tt"
.UpDown = True
End With
End Sub
Function RoundTimeTo(TargetDateTime As String, RoundingInterval As
Integer) As String
'Please ignore the clumsiness of this procedure. I was tired and
it was late.!
Dim CurrMinute
Dim Num
Dim hrs
Dim difr
Dim wrk
Dim adjustment
Dim remainder
Dim TimeInMinutes
Dim wrkDate As Date
wrkDate = CDate(TargetDateTime)
hrs = Hour(wrkDate)
CurrMinute = Minute(CDate(TargetDateTime))
TimeInMinutes = (hrs * 60) + CurrMinute
remainder = TimeInMinutes Mod RoundingInterval
If remainder < RoundingInterval / 2 Then
adjustment = -remainder
ElseIf remainder > RoundingInterval / 2 Then
adjustment = RoundingInterval - remainder
Else
adjustment = 0
End If
wrk = (hrs * 60) + CurrMinute + adjustment
Dim dt As Date
dt = DateSerial(Year(TargetDateTime), Month(TargetDateTime),
Day(TargetDateTime))
wrk = DateAdd("n", wrk, dt)
RoundTimeTo = wrk
End Function