The following code is a class module with an example of its usage to follow.
Class Module Name=classForm - Option Compare Database
-
Option Explicit
-
-
'21/1/2004 Added Private Set & Public Get code for frmTo.
-
'21/9/2004 Removed ResumeTo functionality. _
-
Now handled by the OnTimer() subroutine in the calling form _
-
checking for (Visible) which indicates the called form is finished.
-
'24/2/2005 Added function Uninitialised to show if instance of this object _
-
has yet been initialised with the callers info. _
-
It also checks this before it tries to open a new form.
-
'13/3/2007 Added optional parameter varOpenArgs to be passed 'as is' into _
-
the new form.
-
-
Private Const conUnInitMsg As String = _
-
"Object uninitialised - unable to show form."
-
-
Private frmParent As Form
-
Private WithEvents frmCalled As Form
-
-
Public Property Set frmFrom(frmValue As Form)
-
Set frmParent = frmValue
-
End Property
-
-
Private Property Get frmFrom() As Form
-
Set frmFrom = frmParent
-
End Property
-
-
Private Property Set frmTo(frmValue As Form)
-
Set frmCalled = frmValue
-
End Property
-
-
Public Property Get frmTo() As Form
-
Set frmTo = frmCalled
-
End Property
-
-
'Uninitialised returns True if frmFrom not yet initialised.
-
Public Function Uninitialised() As Boolean
-
Uninitialised = (frmFrom Is Nothing)
-
End Function
-
-
'ShowForm opens form strTo and hides the calling form. Returns True on success.
-
Public Function ShowForm(strTo As String, _
-
Optional varOpenArgs As Variant) As Boolean
-
ShowForm = True
-
'Don't even try if caller hasn't initialised Form object yet
-
If Uninitialised() Then
-
ShowForm = False
-
Call MsgBox(conUnInitMsg, , "classForm.ShowForm")
-
Exit Function
-
End If
-
Call DoCmd.Restore
-
'Handle error on OpenForm() only.
-
On Error GoTo ErrorSF
-
Call DoCmd.OpenForm(FormName:=strTo, OpenArgs:=varOpenArgs)
-
On Error GoTo 0
-
Set frmTo = Forms(strTo)
-
frmFrom.Visible = False
-
Exit Function
-
-
ErrorSF:
-
ShowForm = False
-
Call MsgBox("Error found in [" & frmFrom.Name & _
-
".ShowForm] calling [" & strTo & "]." & VbCrLf & _
-
"Error#=" & Err.Number & " - " & Err.Description & ".")
-
End Function
-
-
'************************* Contained Object Method(s) *************************
-
'For these subroutines to be activated the contained object must have the
-
''On Close' property set to a valid subroutine within the contained object.
-
Private Sub frmCalled_Close()
-
frmFrom.Visible = True
-
Call DoCmd.Restore
-
Set frmTo = Nothing
-
End Sub
-
'***************************************************************************
-
This code is an example menu form. It is calls another form (A, B & C) and is called by another menu (D & E) so incorporates all the code required to make it work.
It is a standard in my databases that reports are always maximised and that forms are always restored, so there is code in her to do that, but this can be stripped without losing the main functionality.
- To use the classForm class it is necessary to Dim a variable to reference it. This need only be declared as Private as it is referenced exclusively internally.
- The variable needs to be set up with the calling form [frmFrom] before it is used in anger.
- Invokes a new form. This causes the current form to be hidden until the invoked form is closed.
- I would typically have a CommandButton on every form to exit.
- In case the x at top-right (or any of a bunch of other methods) is used, the actual tidying up work is (and always should be) done in the Form_Close event procedure. A completely empty procedure is simply dropped at compile time, so a comment line must be included here at least. The class can only pick up (and pass on) the fact that the called form has been closed if this procedure exists in the called form.
- Option Compare Database
-
Option Explicit
-
-
Private clsTo As New classForm '<-- A
-
-
Private Sub Form_Open(Cancel As Integer)
-
Call DoCmd.Restore
-
Set clsTo.frmFrom = Me '<-- B
-
End Sub
-
-
Private Sub cmdGroupCust_Click()
-
Call clsTo.ShowForm(strTo:="frmGroupCust") '<-- C
-
End Sub
-
-
Private Sub cmdExit_Click() '<-- D
-
Call DoCmd.Close(ObjectType:=acForm, ObjectName:=Me.Name)
-
End Sub
-
-
Private Sub Form_Close() '<-- E
-
'Method must exist in order for container to handle event.
-
End Sub
