Question : How to use a module when referencing a calander.

Hi Experts.

In my database to input dates I use a calendar control (MSCAL.Calendar.7) which when clicked drops the date selected into a text box and requeries the form.   It works fine but I now want multiple instances thus a module.

I currently use this individulalized code behind a cmdbutton placed next to a text box

On Error GoTo Err_btn_Diagnose_From_Click
 Dim stDocName As String
   
    stDocName = "frm_Cal_Diagnose_From"
       
    If Not IsNull(txt_Diagnose_From) Then
        DoCmd.OpenForm stDocName
        Forms![frm_Cal_Diagnose_From]![Calendar_Date].Value = txt_Diagnose_From.Value
    Else
        DoCmd.OpenForm stDocName, acNormal
        Forms![frm_Cal_Diagnose_From]![Calendar_Date].Value = Date
    End If
 

Exit_btn_Diagnose_From_Click:
    Exit Sub

Err_btn_Diagnose_From_Click:
    MsgBox Err.Description
    Resume Exit_btn_Diagnose_From_Click


/\\\\\\And the core code behind the click event on the calendar........


 Forms![frm_Personal Medical History]![txt_Diagnose_From].Value = Calendar_Date.Value
      DoCmd.Close
 Forms![frm_Personal Medical History].Requery

///\\\\\
I need to pass the form and text box name to the function and return the calendar date to the text box.

Unfortunately I am not familiar with passing aurguments through to functions and returning them.

Thanks in advance.

Answer : How to use a module when referencing a calander.

Hi mprab

Create a form named frm_Calendar and set the following form properties:
   Popup: Yes
   Modal: Yes
You might also like to set:
   RecordSelectors: No
   ScrollBars: Neither
   NavigationButtons: No
   AutoResize: Yes
   AutoCenter: No
   MinMaxButtons: No
   BorderStyle: Dialog

Add a calendar control to the form and name it calDate.  Set its properties as desired.

Add two command buttons:
   Name: cmdOK
   Caption: OK
   Default: Yes

and
   Name: cmdCancel
   Caption: Cancel
   Cancel: Yes

Then paste this code into the form's class module:

===== start===========
Option Explicit

Public Cancelled As Boolean

Private Sub calDate_DblClick()
 Cancelled = False
 Me.Visible = False
End Sub

Private Sub cmdCancel_Click()
 Cancelled = True
 Me.Visible = False
End Sub

Private Sub cmdOK_Click()
If IsNull(calDate.Value) Then
 MsgBox "Select a date or click Cancel"
Else
 Cancelled = False
 Me.Visible = False
End If
End Sub
======= end ============

Now paste this function into a standard module:

=========== start ===========
Public Function GetDateFromCalendar( _
   Optional TxtBox As TextBox, _
   Optional Caption As String)
Dim cal As Form
On Error GoTo ProcErr
 If TxtBox Is Nothing Then
   If Screen.ActiveControl.ControlType = acTextBox Then
     Set TxtBox = Screen.ActiveControl
   End If
   If TxtBox Is Nothing Then
     mb_Warning "Active control is not a textbox"
     GoTo ProcEnd
   End If
 End If
 Set cal = New Form_frm_Calendar
 With cal
   If Caption <> "" Then
     .Caption = Caption
   ElseIf TxtBox.ControlTipText <> "" Then
     .Caption = TxtBox.ControlTipText
   Else
     .Caption = "Select date"
   End If
   If IsDate(TxtBox) Then !calDate.Value = Nz(TxtBox, Date)
   .Visible = True
   Do While .Visible: DoEvents: Loop
   If Not .Cancelled Then TxtBox = !calDate.Value
 End With
ProcEnd:
 Set cal = Nothing
 Exit Function
ProcErr:
 If Err <> 2467 Then ' ignore "object closed"
   MsgBox Err.Description, vbExclamation, "Error getting date"
 End If
 Resume ProcEnd
End Function
=========== end =================

Save the module (do not name it the same as the function)

Now, wherever you have a textbox that needs a date, you can call this function and pass the textbox as an argument.  For example:
   Call GetDateFromCalendar( txt_Diagnose_From, "Start date of diagnosis" )

If you set the ControlTipText of the textbox, then you don't need to pass the Caption argument:
   Call GetDateFromCalendar( txt_Diagnose_From )

If all you want to do is get the date, then you could use an event propery of the textbox - say OnDblClick:
   =GetDateFromCalendar()

Good luck!
--
Graham

Random Solutions  
 
programming4us programming4us