CallCalled Class Module
I will be adding information about my “CallCalled” Class Module here, as it becomes available. The most recent example of it is on Access World Forums here:-
Class Module - Overview
Class Module - Overview
Video 1 (01:09)
You can see how the Class Module provides some excellent functionality for a pop-up form. The Class Module allows you to grab the Caption of the Calling Control and use it in the caption of the pop-up Form. This means if you call the pop-up form from several different controls. You don’t have to do any coding, it’s all done for you in the class module!
Simulated After Update Event
The Class Module allows you to trigger what I call a “Simulated After Update Event”, this means that the calling form, (the one that calls the pop up) can do a calculation as shown in the video. Alternatively in a situation where you were entering dates for a Range, you could check that an “after date” was greater than the “before date”… Another scenario when you are calculating someone’s age, you can automatically do a calculation, display the age immediately! No waiting for the forms on current event to trigger, or some other event to trigger the calculation.
Video 1 (01:09)
Video Time Indexes
00:10 The popup calculation form opens, and then you can enter the measurements.
00:16 Once you have gathered the measurements,then the SUM of them is passed back into the Calling Control
00:21 notice that the pop-up Form caption changes depending on which control it is open from. All the coding required to extract the Calling Controls caption is done automatically for you in the CallCalled Class module
00:35 The Class Module also provides the very handy utility of being able to run code on the Calling Form, I don't believe is available anywhere else!
00:40 I refer to this unique functionality as a Simulated After Update Event.
… …
PopUp Forms - Easy!
PopUp Forms - Easy!
Video 2 (04:49)
In this video I refer to “Magic” — I remember when I first observed this sort of behaviour, the method of transferring information between objects, I was fascinated! I spent a long time working out what happened, and working out how I could use these techniques in my own coding. I must say I am nowhere near a master of it! I hope you find the magic I found, it was one of the main reasons I got involved in producing VBA code, I realise that you could do just about anything with it!
Video 2 (04:49)
… …
Calendar Form Code
Calendar Form Code
Video 3 (7:42)
This video from 2009 demonstrates an earlier version of the “Call Called Class” module. The Class is being used with a pop-up Calendar Form, a form that pops up to select a date. Using the class module instead of writing your own VBA code makes it a very simple process to pop the calendar form open from any (multiple controls on your form) text-box or command button.
The “Call Called” class module also offers some extra functionality, like the ability to pass the name of the Calling Control gathered from its label, and use its name as the “Form Caption” easily identifying which control you happen to be amending the date of. The “Call Called” class module also allows you to check to see if the form that opened the popup form the “Calling Form”, is still open, if the Calling form has been inadvertently closed, you can take action to prevent error messages being shown to the user…
This demonstration demonstrates the Class Module being used with Allen Browne’s Calendar, and demonstrates how to amalgamate the class module with Allen Browne’s pop-up “Calendar Form”…
Video 3 (7:42)
Please be aware since I did this video in 2009 I have updated the “Call Called Class” and now instead of having to pass through “PassBackRun” in the open arguments, I now have a different routine “Call fHASfPassBackRun” that tests for this when the class module opens. I didn’t like performing this test before, because if the function does not exist it throws an error.
I was always advised never to rely on error messages to operate your code. However I note that some code written by Allen Browne uses this method, and I thought, if it’s good enough for him then it’s good enough for me! To be clear I spent days trying to find a way of doing it without relying on an error code to show that the PassBackRun function was absent. The use of OpenArgs is the correct way to do it. So if you’re a stickler for everything being correct, “Tickety-Boo” then maybe put the OpenArgs method back in….
… …
Latest "Call Called" Class Module
This is the latest version of the Call Called Class Module. You can paste the code below into a class module in your Microsoft Access database and following the instructions you can use it as is. I also provide a sample database with a working example loading up a calendar form.
Option Compare Database
Option Explicit
'MORE INFO on My Website HERE:-
'http://www.niftyaccess.com/callcalled-class-module/
'*******************************************************************************************************
'*************************************** Declarations Section *****************************************
'*******************************************************************************************************
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'>>> Database by Tony Hine, alias Uncle Gizmo <<<
'>>> Created Oct, 2007 <<<
'>>> Last up-dated April, 2021 <<<
'>>> Telephone International: +44 7747 018 875 <<<
'>>> Telephone UK: 07747 018 875 <<<
'>>> e-mail: tonyhine@lay-away.co.uk <<<
'>>> Skype: unclegizmo (I seldom Use Skype) <<<
'>>> I post at the following forum (mostly) : <<<
'>>> http://www.access-programmers.co.uk/forums/ (alias Uncle Gizmo) <<<
'>>> If my e-mail don't work, try this website: http://www.tonyhine.co.uk/example_help.htm <<<
'>>> This is my public playground Website for MS Access:- <<<
'>>> The Nifty Access Website is sales orientated:- <<<
'>>> www.niftyaccess.com (A vehicle for me to generate an income from my retirement) <<<
'>>> My YouTube Channel HERE:- https://www.youtube.com/user/UncleGizmo <<<
'>>> CODE SUPPLIED NOT CHECKED AND TESTED FOR ERRORS!!!! Be Warned <<<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'*******************************************************************************************************
'************************************** Recent Searches & Notes ****************************************
'*******************************************************************************************************
'This Class Can be used to return:-
'The Calling Control Name,
'The Principle Control,
'The Parent Form of the Principle Control,
'Principle Control Caption,
'and more
'*******************************************************************************************************
'**************************************** Declared Constants *******************************************
'*******************************************************************************************************
Const conAppName As String = "Nifty Access - clsCallCalled Class"
Const conATH As String = "Database By Tony Hine Tel: +44 7747 018 875"
'*******************************************************************************************************
'************************ Declare the Private Variable(s) used in this Class ***************************
'*******************************************************************************************************
Private mobjPrincipleCtrl As Object
Private mstrCallingCtrlName As String
Private mstrMainFormName As String
Private mfrmCallingForm As Form
Private mstrPrincipleCtrlCaption As String
Private mFlgDevMode As Boolean
Private mFlgHASfPassBackRun As Boolean
'*******************************************************************************************************
'********************************* Custom Properties used in this Class ********************************
'*******************************************************************************************************
Property Get prpMainFormName() As String
prpMainFormName = mstrMainFormName
End Property 'prpMainFormName Get
Property Get prpCallingCtrlName() As String
prpCallingCtrlName = mstrCallingCtrlName
End Property 'prpCallingCtrlName Get
Public Property Get prpCallingForm() As Form
Set prpCallingForm = mfrmCallingForm
End Property 'prpCallingForm Get
Property Set prpPrincipleCtrl(oPassedCtrl As Object)
Set mobjPrincipleCtrl = oPassedCtrl
End Property 'prpPrincipleCtrl Let
Property Get prpPrincipleCtrl() As Object
Set prpPrincipleCtrl = mobjPrincipleCtrl
End Property 'prpPrincipleCtrl Get
Property Let prpPrincipleCtrlCaption(strPrincipleCtrlCaption As String)
mstrPrincipleCtrlCaption = strPrincipleCtrlCaption
End Property 'prpPrincipleCtrlCaption Let
Property Get prpPrincipleCtrlCaption() As String
prpPrincipleCtrlCaption = mstrPrincipleCtrlCaption
End Property 'prpPrincipleCtrlCaption Get
Property Let prpFlgDevMode(blnFlgDevMode As Boolean)
mFlgDevMode = blnFlgDevMode
End Property 'prpFlgDevMode Let
Property Get prpFlgDevMode() As Boolean
prpFlgDevMode = mFlgDevMode
End Property 'prpFlgDevMode Get
Property Let prpFlgHASfPassBackRun(blnFlgHASfPassBackRun As Boolean)
mFlgHASfPassBackRun = blnFlgHASfPassBackRun
End Property 'prpFlgHASfPassBackRun Let
Property Get prpFlgHASfPassBackRun() As Boolean
prpFlgHASfPassBackRun = mFlgHASfPassBackRun
End Property 'prpFlgHASfPassBackRun Get
'*******************************************************************************************************
'***************************** Class Initialize Event for this Class ***********************************
'*******************************************************************************************************
Private Sub Class_Initialize()
Dim ctrlActiveControl As Control
Dim strAssociateCtrl As String
'////////// Show Extra info for the Developer
prpFlgDevMode = False
Let mstrMainFormName = Screen.ActiveForm.Name 'Get the Active Form (Calling Form)
Set ctrlActiveControl = Screen.ActiveControl 'Get the Control that is Active on the Form.
mstrCallingCtrlName = ctrlActiveControl.Name 'Store the Calling Control Name
Set mfrmCallingForm = fGetParentForm(ctrlActiveControl) 'Store the Form the Control is on, (not always/necessarily the active Form).
'////////// ATH NOTE 2017_05_04 - the "3" in the following line is the prefix length. change it to your prefered coding practice
strAssociateCtrl = fGetAssociateCtrl(prpCallingForm, prpCallingCtrlName, 3)
Set mobjPrincipleCtrl = prpCallingForm(strAssociateCtrl) 'Store the Principle Control
Let mstrPrincipleCtrlCaption = fGetLabel(prpCallingForm, prpPrincipleCtrl) 'Store the Principle Control's Label's Caption
Call fHASfPassBackRun 'Check to see if the Routine "fPassBackRun" exists in the Calling form
'////////// For Testing - Show the Principle Control's Label's Caption
If prpFlgDevMode Then
MsgBox " >>> PrincipleCtrl Caption is:- " & prpPrincipleCtrlCaption, , conAppName
If prpFlgHASfPassBackRun Then
MsgBox " >>> The Calling Form >>> " & prpCallingForm.Name & _
" Contains a Public Function named fPassBackRun (pass-back-run) ", , conAppName
Else
MsgBox " >>> The Calling Form >>> " & prpCallingForm.Name & _
" Does NOT Contain a Public Function named fPassBackRun (pass-back-run) ", , conAppName
End If
End If
End Sub 'Class_Initialize
'*******************************************************************************************************
'****************************** Class Terminate Event for this Class ***********************************
'*******************************************************************************************************
Private Sub Class_Terminate()
Set mobjPrincipleCtrl = Nothing
Set mfrmCallingForm = Nothing
End Sub 'Class_Terminate
'*******************************************************************************************************
'*********************** Public Subroutines and Functions used in this Class ***************************
'*******************************************************************************************************
Public Function fActiveFormLoaded() As Boolean
'Returns true if "prpMainFormName" (Property containing the name of the form to check) is open
Dim strSubName As String
Dim strModuleName As String
strSubName = "fActiveFormLoaded"
strModuleName = "Module - clsCallCalled"
On Error GoTo Error_Handler
'From:-
'https://docs.microsoft.com/en-us/office/vba/api/access.accessobject.isloaded
If CurrentProject.AllForms(prpMainFormName).IsLoaded Then
fActiveFormLoaded = True
Else
MsgBox "The Active Form has been unexpectedly closed. One solution to this problem is to make the Pop-Up form Modal", , conAppName
End If
Exit_ErrorHandler:
Exit Function
Error_Handler: 'Version - 1a
Dim strErrFrom As String
Dim strErrInfo As String
strErrFrom = "Error From:-" & vbCrLf & strModuleName & vbCrLf & "Subroutine >>>>>>> " & strSubName
strErrInfo = "" & vbCrLf & "Error Number >>>>> " & Err.Number & vbCrLf & "Error Descscription:-" & vbCrLf & Err.Description
Select Case Err.Number
Case 0.123 'When Required, Replace Place Holder (0.123) with an Error Number
MsgBox "Error produced by Place Holder please check your code!" & vbCrLf & vbCrLf & strErrFrom & strErrInfo, , conAppName
Case Else
MsgBox "Case Else Error" & vbCrLf & vbCrLf & strErrFrom & strErrInfo, , conAppName
End Select
Resume Exit_ErrorHandler
End Function 'fActiveFormLoaded
'*******************************************************************************************************
'********************** Private Subroutines and Functions used in this Class ***************************
'*******************************************************************************************************
Private Function fGetParentForm(ctrlActiveControl As Control) As Form
Dim strSubName As String
Dim strModuleName As String
strSubName = "fGetParentForm"
strModuleName = "Module - clsCallCalled"
On Error GoTo Error_Handler
Dim ctlToTest As Control
Set ctlToTest = ctrlActiveControl 'Will Always be a "Control? No Not always... "
'/////////// CHECK THIS ...No Not always...
Dim X As Integer
For X = 1 To 20 'This will check to 20 levels
If Not fParentIsaForm(ctlToTest.Parent.Name) Then 'Is Parent a Form?
'It's not a form, so it must still be a control so carry on checking a "Control"
Set ctlToTest = ctlToTest.Parent 'No --- Then check the next Parent
Else
'It is a form, so you have found the form that the control is on.
Set fGetParentForm = ctlToTest.Parent 'Yes -- Then Set the Property to The Parent Form
Exit For
End If
Next X
'I cannot foresee a situation with more than 20 levels, but I thought a check on it would be wise
If X >= 20 Then MsgBox "Message from clsCallCalled ---" & "ERROR 20 Levels EXCEEDED, change 20 to a higher Figure ---", , conAppName
'////////// For Testing -
If prpFlgDevMode Then
MsgBox " >>> WARNING !!! --- DEVELOPER MODE IS ACTIVE!!!", , conAppName
MsgBox "Level Checked to is :- " & X & " Level(s)", , conAppName
End If
Exit_ErrorHandler:
Exit Function
Error_Handler:
Dim strErrFrom As String
Dim strErrInfo As String
strErrFrom = "Error From:-" & vbCrLf & strModuleName & vbCrLf & "Subroutine >>>>>>> " & strSubName
strErrInfo = "" & vbCrLf & "Error Number >>>>> " & Err.Number & vbCrLf & "Error Descscription:-" & vbCrLf & Err.Description
Select Case Err.Number
Case 1 'When Required, Replace Place Holder (1) with an Error Number
MsgBox "Error produced by Place Holder please check your code!" & vbCrLf & vbCrLf & strErrFrom & strErrInfo, , conAppName
Case Else
MsgBox "Case Else Error" & vbCrLf & vbCrLf & strErrFrom & strErrInfo, , conAppName
End Select
Resume Exit_ErrorHandler
End Function 'fGetParentForm
Private Function fParentIsaForm(strIsaForm As String) As Boolean
'From Access Help
'https://msdn.microsoft.com/en-us/library/office/ff822456.aspx
fParentIsaForm = False
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentProject
' Search for open AccessObject objects in AllForms collection.
For Each obj In dbs.AllForms
If obj.Name = strIsaForm Then fParentIsaForm = True
Next obj
End Function 'fParentIsaForm
Private Function fGetAssociateCtrl(frmCallingForm As Form, strActiveCtrlName As String, intPrefixLen As Integer) As String
'Looks for any Control with the same name, makes sure there's only one control, and returns that control.
Dim strNamePart As String
strNamePart = Right(strActiveCtrlName, Len(strActiveCtrlName) - intPrefixLen) 'The active control name without the prefix
'Length of prefix determined by:- intPrefixLen
'Prefix Removed (Naming Convention)
Dim strFoundControlName As String
Dim Ctrl As Control
Dim X As Integer
For Each Ctrl In frmCallingForm
Select Case Ctrl.ControlType
Case acComboBox, acTextBox ', acLabel ', acCommandButton ', acCheckBox, acListBox, acOptionButton, acOptionGroup, acToggleButton
If strActiveCtrlName <> Ctrl.Name Then 'Skip if it's the same Control
If Right(Ctrl.Name, Len(Ctrl.Name) - intPrefixLen) = strNamePart Then
X = X + 1
strFoundControlName = Ctrl.Name
End If
End If
End Select
Next Ctrl
Dim strCtrlToUse As String
Select Case X
Case Is = 0 'No Associate Control Found
strCtrlToUse = strActiveCtrlName
'////////// For Testing -
If prpFlgDevMode Then MsgBox "NO ASS CTRL", , conAppName
Case Is = 1 'One Associate Control Found
strCtrlToUse = strFoundControlName
Case Is > 1 'More than one Associate Control Found
MsgBox "From Function: fGetAssociateCtrl in the Form: frmExample. More than " & _
"one Control Found with the Same Name. The Control " & Chr(34) & strActiveCtrlName & Chr(34) & _
" will be made the Principle Control. Correct the Conflicting names to Continue.", , conAppName
strCtrlToUse = strActiveCtrlName
Case Else
MsgBox "From Function: fGetAssociateCtrl in the Form: frmExample. Unforeseen " & _
"Error in Case Statement. The Control " & Chr(34) & strActiveCtrlName & Chr(34) & _
" will be made the Principle Control. Please find the Fault before Continuing.", , conAppName
strCtrlToUse = strActiveCtrlName
End Select
fGetAssociateCtrl = strCtrlToUse
End Function 'fGetAssociateCtrl
Private Function fHasLabel(oFormPassed As Form, strCtrlName As String) As Boolean
'This function Returns True if the control "Name" entered has an associated label.
'Used in "fGetLabel"
Dim Ctrl As Control
For Each Ctrl In oFormPassed
If Ctrl.ControlType = acLabel Then
If Ctrl.Parent.Name = strCtrlName Then fHasLabel = True
End If
Next
End Function 'fHasLabel
Private Function fGetLabel(oFormPassed As Form, oCtrl As Control) As String
'Extract the caption from the Associate Controls label...
If fHasLabel(oFormPassed, oCtrl.Name) Then
fGetLabel = oCtrl.Controls(0).Caption
Else
fGetLabel = ""
End If
End Function 'fGetLabel
Private Sub fHASfPassBackRun()
'Test to see if the function "fPassBackRun" (Pass-back-run) exists in the Calling Form
'If it does then sets the property "prpFlgHASfPassBackRun" to true.
Dim strSubName As String
Dim strModuleName As String
strSubName = "fHASfPassBackRun"
strModuleName = "Module - clsCallCalled"
On Error GoTo Error_Handler
prpFlgHASfPassBackRun = True
'Call the Function fPassBackRun to Test to see if it Exists
prpCallingForm.fPassBackRun ("# ~ Never Use this in the fPassBackRun Case Statement #~#~3£&8* ")
'If the Function fPassBackRun does not exist it Triggers Error 2465 which is handled below
Exit_ErrorHandler:
Exit Sub
Error_Handler: 'Version - 1a
Dim strErrFrom As String
Dim strErrInfo As String
strErrFrom = "Error From:-" & vbCrLf & strModuleName & vbCrLf & "Subroutine >>>>>>> " & strSubName
strErrInfo = "" & vbCrLf & "Error Number >>>>> " & Err.Number & vbCrLf & "Error Descscription:-" & vbCrLf & Err.Description
Select Case Err.Number
Case 2465 'Application-defined or object-defined error
'UnCheck This Message for Testing
'MsgBox "Error Caused because - fPassBackRun does not exist" & vbCrLf & vbCrLf & strErrFrom & strErrInfo, , conAppName
prpFlgHASfPassBackRun = False 'Flag that the Function fPassBackRun does not exist
Err.Number = 0 'An Expected Error, - so Reset
Resume Next 'Resume as if no Error Occured
Case Else
MsgBox "Case Else Error" & vbCrLf & vbCrLf & strErrFrom & strErrInfo, , conAppName
End Select
Resume Exit_ErrorHandler
End Sub 'fHASfPassBackRun
