asked on

Locking field to prevent less than popup calendar date and changes manually

Hello Experts

I have a field control (DateReceived) which is populated with a date selected from a popup calendar. I have coded the afterupdate with the following code below to lock the field. When the date is populated into the DateReceived field with the popup calendar you can close the popup calendar but the I-beam remains in the field allowing you to change the date and time, albeit with an error message, but none the less it changes and saves.

What I am trying to accomplish is to not allow a date from the popup calendar entered in to the field to be less than the current date and to disable the ability to enter data manually into the field or to change the date entered in the field from the popup calendar.

Thank you for any assistance you can provide

Private Sub DateReceived_AfterUpdate()
If Not IsNull(Me.DateReceived) Then
Me.DateReceived.Locked = True
Me.DateReceived.BackStyle = "Transparent"

End If

End Sub

peter57r

Which version of Access?
If it's A2003 or earlier which calendar control are you using?

Beeyen

ASKER

Thank you for responding,

The version of Access is 2003.

The custom coding of the calendar " On Click" of the field is as following with the coding for the Calandar form located further below

Option Compare Database
Option Explicit

'Calendar form variable:
Public gtxtCalTarget As TextBox 'Text box to return the date from the calendar to.
Public Function CalendarFor(txt As TextBox, Optional strTitle As String)
'On Error GoTo Err_Handler
'Purpose: Open the calendar form, identifying the text box to return the date to.
'Arguments: txt = the text box to return the date to.
' strTitle = the caption for the calendar form (passed in OpenArgs).

Set gtxtCalTarget = txt
DoCmd.OpenForm "frmCalendar", windowmode:=acDialog, OpenArgs:=strTitle

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "CalendarFor()"
Resume Exit_Handler
End Function

Option Compare Database
Option Explicit

Private Const conMod = "frmCalendar"

Private Sub cmdCancel_Click()
On Error GoTo Err_Handler
    'Purpose:   Close without transferring date back to calling text box.
    
    DoCmd.Close acForm, Me.Name, acSaveNo

Exit_Handler:
    Exit Sub

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".cmdCancel_Click")
    Resume Exit_Handler
End Sub

Private Sub cmdMonthDown_Click()
    Call SetDate("M", -1)
End Sub
Private Sub cmdMonthUp_Click()
    Call SetDate("M", 1)
End Sub

Private Sub cmdOK_Click()
On Error Resume Next
    'Purpose:   Transfer the result back to the calling text box (if there is one), and close.
    
    If Me.cmdOk.Enabled Then
        If gtxtCalTarget = Me.txtDate Then
            Me.txtDate = Now() 'do nothing
            
        ElseIf Me.txtDate = Date Then
        
            gtxtCalTarget = Me.txtDate + Time
            
        ElseIf Me.txtDate < Date Then
        
            gtxtCalTarget = Me.txtDate + #4:30:00 PM#
            
        ElseIf Me.txtDate < Date + #11:59:59 PM# Then
        
            gtxtCalTarget = Now()
            
            
        ElseIf Me.txtDate > Date + #11:59:59 PM# Then
        
            gtxtCalTarget = Me.txtDate + #8:00:00 AM#
        End If
    End If
    gtxtCalTarget.SetFocus
    DoCmd.Close acForm, Me.Name, acSaveNo
End Sub

Private Sub cmdToday_Click()
'On Error GoTo Err_Handler
    'Purpose:   Set today.
    
    Me.txtDate = Date
    Call ShowCal
    
Exit_Handler:
    Exit Sub
    
Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".cmdToday_Click")
    Resume Exit_Handler
End Sub

Private Sub cmdYearDown_Click()
    Call SetDate("YYYY", -1)
End Sub
Private Sub cmdYearUp_Click()
    Call SetDate("YYYY", 1)
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'On Error GoTo Err_Handler
    'Purpose:
    
    With Me.txtDate
        Select Case KeyCode
        Case vbKeyLeft              '1 day left or right.
            .Value = .Value - 1
            KeyCode = 0
            Call ShowCal
        Case vbKeyRight
            .Value = .Value + 1
            KeyCode = 0
            Call ShowCal
        Case vbKeyUp                '1 week up or down.
            .Value = .Value - 7
            KeyCode = 0
            Call ShowCal
        Case vbKeyDown
            .Value = .Value + 7
            KeyCode = 0
            Call ShowCal
        Case vbKeyHome              'Home/End = first/last of this month.
            .Value = .Value - Day(.Value) + 1
            KeyCode = 0
            Call ShowCal
        Case vbKeyEnd
            .Value = DateSerial(year(.Value), month(.Value) + 1, 0)
            KeyCode = 0
            Call ShowCal
        Case vbKeyPageUp            'PgUp/PgDn = previous/next month.
            .Value = DateAdd("m", -1, .Value)
            KeyCode = 0
            Call ShowCal
        Case vbKeyPageDown
            .Value = DateAdd("m", 1, .Value)
            KeyCode = 0
            Call ShowCal
        Case vbKeyT, vbKeyT + 32    'T or t = today
            .Value = Date
            KeyCode = 0
            Call ShowCal
        End Select
    End With
    
Exit_Handler:
    Exit Sub
    
Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".Form_KeyDown")
    Resume Exit_Handler
End Sub

Private Sub Form_Open(Cancel As Integer)
'On Error GoTo Form_Open_Err
    Dim bEnabled As Boolean
    
    'Initialize to the existing date, or today if null.
    If IsDate(gtxtCalTarget) Then
        Me.txtDate = gtxtCalTarget.Value
    Else
        Me.txtDate = Now()
    End If
    
    'Lock the Ok button if the text box is locked or disabled.
    bEnabled = (gtxtCalTarget.Enabled) And (Not gtxtCalTarget.Locked)
    With Me.cmdOk
        If .Enabled <> bEnabled Then
            .Enabled = bEnabled
        End If
    End With
   
    'Set the title
    If Len(Me.OpenArgs) > 0& Then
        Me.Caption = Me.OpenArgs
    End If
    
    'Set up the calendar for this month.
    Call ShowCal

Form_Open_Exit:
    Exit Sub

Form_Open_Err:
    MsgBox Err.Description, vbCritical, "frmCalendar.Form_Open"
    Resume Form_Open_Exit
End Sub

Private Function SetSelected(ctlName As String)
On Error GoTo Err_Handler

    Me.txtDate = DateSerial(year(txtDate), month(txtDate), CLng(Me(ctlName).Caption))
    Call ShowHighligher(ctlName)

Exit_Handler:
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".SetSelected")
    Resume Exit_Handler
End Function

Private Function SelectDate(ctlName As String)
    Call SetSelected(ctlName)
    Call cmdOK_Click
End Function

Private Function SetDate(Subject As String, Optional intStep As Integer = 1)
On Error GoTo Err_Handler
    
    Me.txtDate = DateAdd(Subject, intStep, Me.txtDate)
    Call ShowCal

Exit_Handler:
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".SetDate")
    Resume Exit_Handler
End Function

Private Function ShowCal() As Boolean
On Error GoTo Err_Handler
    'Purpose:
    Dim dtStartDate As Date     'First of month
    Dim iDays As Integer        'Days in month
    Dim iOffset As Integer      'Offset to first label for month.
    Dim i As Integer            'Loop controller.
    Dim iDay As Integer         'Day under consideration.
    Dim bShow As Boolean        'Flag: show label
    
    dtStartDate = Me.txtDate - Day(Me.txtDate) + 1  'First of month
    iDays = Day(DateAdd("m", 1, dtStartDate) - 1)   'Days in month.
    iOffset = WeekDay(dtStartDate, vbSunday) - 2    'Offset to first label for month.
    
    For i = 0 To 41
        With Me("lblDay" & Format(i, "00"))
            iDay = i - iOffset
            bShow = ((iDay > 0) And (iDay <= iDays))
            If .Visible <> bShow Then
                .Visible = bShow
            End If
            If (bShow) And (.Caption <> iDay) Then
                .Caption = iDay
            End If
        End With
    Next
    
    Call ShowHighligher("lblDay" & Format(Day(Me.txtDate) + iOffset, "00"))
    
Exit_Handler:
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".ShowCal")
    Resume Exit_Handler
End Function

Private Function ShowHighligher(ctlName As String)
On Error GoTo Err_Handler
    Const lngcVOffset As Long = -83

    With Me(ctlName)
        Me.lblHighlight.Left = .Left
        Me.lblHighlight.Top = .Top + lngcVOffset
    End With

Exit_Handler:
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".ShowHighligher")
    Resume Exit_Handler
End Function

Private Sub lblHelp_Click()
    MsgBox Me.lblHelp.ControlTipText, vbInformation, "Calendar help"
End Sub

Open in new window

conagraman

change your textbox to locked = true. then in your before update event add a code something like

if me.yourtextboxname is =< Date() then me.yourtextboxname = "" 'clear the unwanted date'
msgbox("date needs to be in the future") 'tell your user to choose a new date

end if

conagraman

i should say keep your textbox field to locked true. this will still allow your onclick event to fire but wont let your user type info in

hope this helps

Beeyen

ASKER

Thanks but that did not work. A user can continue to enter a different date less than the current date or change it manually.

Any other ideas?

conagraman

try what i said in my first post

if me.yourtextboxname is =< Date() then
'clear the unwanted date'
me.yourtextboxname = ""
msgbox("date needs to be in the future") 'tell your user to choose a new date

end if

yes they will be able to click on a date in the past but it wont let them use it and it will clear it from the field and then tell them what to do

use that with locked = true

i think this will work for you

Beeyen

ASKER

Like this:

Private Sub DateReceived_BeforeUpdate(Cancel As Integer)
If Me.DateReceived >= Date Then 'clear the unwanted date'
Me.DateReceived = ""
MsgBox ("date needs to be in the future") 'tell your user to choose a new date
Else
Me.DateReceived = True

End If

End Sub

Beeyen

ASKER

Or rather:

Like this:

Private Sub DateReceived_BeforeUpdate(Cancel As Integer)
If Me.DateReceived >= Date Then 'clear the unwanted date'
Me.DateReceived = ""
MsgBox ("date needs to be in the future") 'tell your user to choose a new date
Else
Me.DateReceived.locked = True

End If

End Sub

ASKER CERTIFIED SOLUTION

conagraman

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

conagraman

also i might try it in the dirty or onchange events

Beeyen

ASKER

Good Day conagraman,

Thank you for your persistence and patience with this question. I am using the Me.controlname.locked = true with the field/property to locked = true.

As in my original posting, to prevent a date selected from the popup calendar into the field to be less than the current date or to disable the ability to change a date manually, I have resorted to the Validation Rules [>=Date()] with the Validation Text for explanation.

Everything works great!

Thanks again

Beeyen

ASKER

The validation rule was part of the answer and the other part was the locking rule suggested by conagraman.