John Colby
jwcolby at ColbyConsulting.com
Mon Jan 30 08:23:51 CST 2006
Access comes with a built-in calendar control. Kinda lame but it works. I needed a quick and dirty calendar the other day and decided to marry this calendar control with my filter function to get this thing working in a hurry. I have discussed my "filter" function many times in this group. Basically it is a function with a collection which holds values, keyed on the name passed in to the function. What isn't apparent is that with a little work you can also pass in pointers to controls themselves. What this allows is for a calling form to place a reference to a control on the calling form into the Fltr collection, then open the calendar form. The calendar form then does it's thing, and when it is time to return a value, it goes and gets the pointer to the control on the calling form, places the value in that control, and closes. Works a treat. The demo is up on my site, complete with the calendar form, the FltrCtl function, and a calling form which demos getting a data. Go to www.ColbyConsulting.com Register if you haven't already Log in. Click Example Code / Utilities / C2DbCalendarDemo The code: '=========================================================================== ========= 'The code for the filter function, modified to handle pointers to objects '=========================================================================== ========= ' 'The following code expands upon the basic filter function above to allow storing and 'returning objects of any kind - controls, forms, classes etc. ' 'The code takes advantage of the fact that a variant can store a pointer to an object. 'In order to determine if the thing stored is an object or a normal variable, a SET statement 'is performed first and the err object is checked. If the thing stored is not an error then the 'Err object will not be zero, in which case we treat the thing stored as a simple variable. ' Public Function FltrCtl(lstrName As String, Optional lvarValue As Variant) As Variant On Error GoTo Err_fltrCtl Static mcolFilter As Collection Static blnInitialized As Boolean If Not blnInitialized Then 'if the collection not initialized yet, do so now Set mcolFilter = New Collection blnInitialized = True End If ' 'We have a valid collection, next check for a value passed in ' If IsMissing(lvarValue) Then ' 'No value was passed in so check in the collection 'using the variable name (key) ' 'We are going to pass back the value. Determine if it is an object 'by using the set statement and checking for an error ' On Error Resume Next Set FltrCtl = mcolFilter(lstrName) If Err <> 0 Then 'if the Err obj is <> zero then it was not an object Err.Clear FltrCtl = mcolFilter(lstrName) If Err <> 0 Then ' 'There was no value in the collection under that name (key) 'so just return a null ' FltrCtl = Null End If End If Else ' 'A value was passed in so ' On Error Resume Next ' 'Remove any value already in the collection under that name (key) '(if any) ' mcolFilter.Remove lstrName Err.Clear ' 'And then add it back in to the collection ' mcolFilter.Add lvarValue, lstrName ' 'We are going to pass back the value. Determine if it is an object 'by using the set statement and checking for an error ' Set FltrCtl = lvarValue If Err <> 0 Then 'if the Err obj is <> zero then it was not an object FltrCtl = lvarValue 'so just return the value as a variable End If End If Exit_fltrCtl: Exit Function Err_fltrCtl: MsgBox Err.Description, , "Error in Function basfltrCtlFunctions.fltrCtl" Resume Exit_fltrCtl Resume 0 '.FOR TROUBLESHOOTING End Function '=========================================================================== ========= 'The code for the form needing to use the calendar '=========================================================================== ========= Private Sub cmdCalDteFrom_Click() 'Set a pointer to the text box which needs a date FltrCtl "CalDte", txtDateFrom OpenCal End Sub ' 'The standard "open a form" code which opens the calendar form ' Private Sub OpenCal() Dim stDocName As String Dim stLinkCriteria As String stDocName = "frmCalendar" DoCmd.OpenForm stDocName, , , stLinkCriteria, , acDialog End Sub John W. Colby www.ColbyConsulting.com