Access pattern · popup pass-back

CallCalled Class Module

A popup helper so the calling control’s caption becomes the popup form caption, and a Simulated After Update so the calling form can recalculate when the popup closes. Paste the class into your database. No sample file on this page.

Forum example: VBA to reuse a data-entry popup (Access World Forums, Uncle Gizmo).

Videos that used to sit on this page may return later. The class and the written explanation are here now.

Class module overview

You can see how the class module gives a popup form some excellent functionality. It grabs the caption of the calling control and uses it as the caption of the popup. Call the same popup from several different controls and you do not have to write that caption code yourself — it is in the class.

Simulated After Update

The class can trigger what I call a Simulated After Update Event. The calling form (the one that opened the popup) can do a calculation as soon as the popup closes. Examples:

  • A measurements popup: enter the figures, the sum is written back into the calling control.
  • A date range: check that an “after” date is greater than the “before” date.
  • Someone’s age: calculate and display it immediately, without waiting for the form’s On Current event.

The popup caption changes depending on which control opened it. All of the work to extract the calling control’s caption is in CallCalled. It can also run code on the calling form — a utility I do not believe is available anywhere else. That is the Simulated After Update.

I used to call this “magic”. When I first saw information moving between objects like this, I was fascinated. I spent a long time working out what happened, and how I could use it in my own coding. I am still 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. You can do just about anything with it.

Calendar form code

An earlier version of CallCalled sat under a popup calendar: click a text box or a command button, pick a date, close. Using the class instead of writing your own VBA makes it a simple process to open that calendar from any (several) controls on the form.

Extra functionality: the name of the calling control, gathered from its label, becomes the form caption, so you can see which date you are amending. The class can also check whether the calling form is still open. If someone closed it by mistake, you can stop error messages landing on the user.

That calendar demonstration used Allen Browne’s popup Calendar Form amalgamated with this class.

Since 2009 I have updated the class. You no longer have to pass PassBackRun in OpenArgs. There is a routine fHASfPassBackRun that tests for fPassBackRun when the class opens. I did not like the old test, 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. Some code written by Allen Browne uses that method, and I thought: if it is good enough for him, it is good enough for me. To be clear, I spent days trying to detect a missing fPassBackRun without an error code. OpenArgs is the “correct” way. If you are a stickler for everything being Tickety-Boo, put the OpenArgs method back in.

Latest CallCalled class module

This is the latest version (Drive Doc, April 2021 header). Paste it into a class module named clsCallCalled in your Microsoft Access database and follow the comments. There is no sample .accdb download on this page.

The listing is coloured like Visual Studio on a white sheet. Switch the site to Light (top right) if names look faint — keywords stay blue either way.

VBA · clsCallCalled 
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