Calendar trouble

[PB90]

I have a form which accepts 15 date fields through the use of a calendar.
dtSubmitted should be <= current date, the "request" dates should be >= current date.

Problem: When an invalid date is entered for a "request" date, the next time the mouse is clicked on the date field, instead of the calendar remaining open for a selection, it flashes open and then closes with the current date filled into the field. It functions correctly when an invalid dtSubmitted is entered, it opens & waits for a selection to be made. The only thing I know that is different, is that the calendar is "placed" in a particular place for the "request" dates. This has functioned correctly until today, when I added the check for invalid entries in "ocxCalendar_AfterUpdate()". All help to stop this eratic behavior is appreciated.

My code is below.


Private Sub ocxCalendar_AfterUpdate()

Dim Msg As String
Dim Response As String
' uncomment this code prior to release
' this makes sure valid dates are selected from the
' calendar.
If cboOriginator.Value = cboDtSubmitted Then
' dtSubmitted should occur in the past or current date
If ocxCalendar.Value > Date Then
cboOriginator.Value = Null
cboOriginator.SetFocus
Msg = "YOU MUST PICK TODAYS DATE OR A DATE IN THE PAST "
MsgBox Msg, vbRetryCancel + vbExclamation, "INCORRECT DATE!"
End If
Else
' all channel request dates should occur today or in the future

If ocxCalendar.Value < Date Then
cboOriginator.Value = Null
cboOriginator.SetFocus
Msg = "YOU MUST PICK TODAYS DATE OR A DATE IN THE FUTURE "
MsgBox Msg, vbRetryCancel + vbExclamation, "INCORRECT DATE!"
End If
End If
End Sub


Private Sub ocxCalendar_Click()
cboOriginator.Value = ocxCalendar.Value
cboOriginator.SetFocus
cboOriginator.BackColor = 16777215
ocxCalendar.Visible = False
Set cboOriginator = Nothing

End Sub


Private Sub ocxCalendar_LostFocus()
Me.TimerInterval = 50
End Sub


Private Sub Place_Calendar_Start()
ocxCalendar.Top = 4020.048
ocxCalendar.Left = 2459.952
ocxCalendar.Visible = True
ocxCalendar.SetFocus
If Not IsNull(cboOriginator) Then
ocxCalendar.Value = cboOriginator.Value
Else
ocxCalendar.Value = Date
End If
End Sub

Private Sub Place_Calendar_EndDt()
ocxCalendar.Top = 4020.048
ocxCalendar.Left = 6120
ocxCalendar.Visible = True
ocxCalendar.SetFocus
If Not IsNull(cboOriginator) Then
ocxCalendar.Value = cboOriginator.Value
Else
ocxCalendar.Value = Date
End If
End Sub


Private Sub cboDtSubmitted_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Set cboOriginator = cboDtSubmitted
ocxCalendar.Top = 1500
ocxCalendar.Left = 5760
ocxCalendar.Visible = True
ocxCalendar.SetFocus
If Not IsNull(cboOriginator) Then
ocxCalendar.Value = cboOriginator.Value
Else
ocxCalendar.Value = Date
End If
End Sub

 

[dRahme]

Hello, in addressing the after update and on click events,
I would get rid of the after update part and include the necessary pieces in the on Click event.

I added a frame which provides a request and submit option. After the frame update the calendar appears visible and is set to the current date.

I'd stay away from using All Caps and many exclamation marks in message boxes. Gets hard on the eyes.

Private Sub frmRequest_AfterUpdate()

'Set Calendar to Visible after Frame Selection
Me.ocxCalendar.Visible = True
Me.ocxCalendar.SetFocus

End Sub

Private Sub ocxCalendar_GotFocus()

'Set to Today's Date

Me.ocxCalendar.Value = Now()

End Sub


Private Sub ocxCalendar_Click()
'Determine if Date selected is appropriate

Select Case Me.frmRequest

Case Is = 1 'Request

If Me.ocxCalendar.Value >= Now() Then
MsgBox "This is correct" 'Do Something

Else:

MsgBox "Incorrect Date. Please Select a Date > = Today's Date", vbInformation, "Resubmit"

Me.ocxCalendar.Value = Now()

End If

Case Is = 2 'Submission

If Me.ocxCalendar.Value <= Now() Then
MsgBox "This is correct" 'Do Something

Else:

MsgBox "Incorrect Date. Please Select a Date < = Today's Date", vbInformation, "Resubmit"

Me.ocxCalendar.Value = Now()

End If

End Select

End Sub


Hope that helps