S
sarndt
I have datetimepicker controls on my worksheet. They are set to display time
in hh:mm tt format. I've coded the change events to add/subtract an hour
based on going from hh:59 to hh:60 and hh:00 to hh:59. This works fine if
you click on the updown arrow in the spinner portion of the control. But it
doesn't work if you hold down the mouse key. What happens in this case is
the minutes go/up down, but the hour doesn't change. My code so far is as
follows:
Public Time As Date
Private Sub DTPicker1_SD_GotFocus()
Time = DTPicker1_SD.Value
End Sub
Private Sub DTPicker1_SD_Change()
DTPicker1_SD.Value = Validate_Time(DTPicker1_SD)
Time = DTPicker1_SD.Value
End Sub
Private Function Validate_Time(ByRef DTPickerField As DTPicker)
Dim Time_Mn As Integer
Time_Mn = Minute(Time)
If Time_Mn = 0 And DTPickerField.Minute = 59 Then
If DTPickerField.Hour = 0 Then
DTPickerField.Hour = 11
Else
DTPickerField.Hour = DTPickerField.Hour - 1
End If
End If
If Time_Mn = 59 And DTPickerField.Minute = 0 Then
DTPickerField.Hour = DTPickerField.Hour + 1
End If
Set Validate_Time = DTPickerField
End Function
Thanks in advance for any assistance
in hh:mm tt format. I've coded the change events to add/subtract an hour
based on going from hh:59 to hh:60 and hh:00 to hh:59. This works fine if
you click on the updown arrow in the spinner portion of the control. But it
doesn't work if you hold down the mouse key. What happens in this case is
the minutes go/up down, but the hour doesn't change. My code so far is as
follows:
Public Time As Date
Private Sub DTPicker1_SD_GotFocus()
Time = DTPicker1_SD.Value
End Sub
Private Sub DTPicker1_SD_Change()
DTPicker1_SD.Value = Validate_Time(DTPicker1_SD)
Time = DTPicker1_SD.Value
End Sub
Private Function Validate_Time(ByRef DTPickerField As DTPicker)
Dim Time_Mn As Integer
Time_Mn = Minute(Time)
If Time_Mn = 0 And DTPickerField.Minute = 59 Then
If DTPickerField.Hour = 0 Then
DTPickerField.Hour = 11
Else
DTPickerField.Hour = DTPickerField.Hour - 1
End If
End If
If Time_Mn = 59 And DTPickerField.Minute = 0 Then
DTPickerField.Hour = DTPickerField.Hour + 1
End If
Set Validate_Time = DTPickerField
End Function
Thanks in advance for any assistance