Using CallByName with an 'event sink' for

问题:

I have text boxes on several forms in my application that have a "zoom" capability -- double-click on them and a pop-up form appears which you can resize and edit to your hearts content. This is coded via a class module "appZoomText" which acts as an 'event sink' for the text box events.

I'm trying to create a content menu and ribbon item which replicates the double click behaviour (for those of my users who don't read documentation but might wonder what a zoom icon does if they see it.)

On entry to a zoomable text box, this code is executed:

dim mclsZoomtext as appZoomtext
set mclsZoomtext = new appZoomtext
Set mclsZoomText.pTextBox = ActiveControl

In the class module, the following code is executed in Set pTextBox

Private WithEvents myTextBox As Access.TextBox
Set myTextBox = pTextBox
myTextBox.OnDblClick = "[Event Procedure]"

The double-click code for myTextBox is:

Private Sub myTextBox_DblClick(intCancel As Integer)
   OpenZoomForm 'Opens the relevant form with the right contents -- works fine
End Sub

The relevant menu item is enabled in Set ptextBox and disabled when pTextBox is exited (this is working fine).

The code invoked when the context menu item is clicked is:

Public Function OnActionZoom() As Boolean

Dim ctl As Control

Set ctl = GetCurrentControl
'GetCurrentControl returns the current Control object on a form or subform and works fine

CallByName ctl.Parent, ctl.Name & "_DblClick", VbMethod

OnActionZoom = True

End Function

I get an error 2465 ("can't find the field referred to") on the CallByName line. I'm assuming that this is because the DblClick code is in the event sink not the form. ctl.parent and ctl.name are set correctly.

How can I code this to invoke the event sink code?

Update: I've tried creating an empty (Public) Field_DblClick sub in the form; doesn't help - this empty sub runs but the event in the class module doesn't fire. Neither does making myTextBox_DblClick Public instead of Private.

In this instance I could just invoke OpenZoomForm directly, or maybe I could have a single public instance of appZoomText that gets associated with different textboxes as required (I haven't tried this).

However, I need to use a similar method to create a menu item to drill-down in a number of comboboxes and textboxes -- double-clicking in the combo-box/textbox opens an edit form for the item in the ox -- but the edit form isn't always the same, and I can't have a single public instance of each event sink.

Similar code:

Combobox_Enter or TextBox_Enter:

dim mclsClass as ClassX
set mclsClass as new ClassX
set mclsClass.ComboBox = ActiveControl 'Or set mclsClass.textbox = activecontrol

in ClassX:

    Private Withevents myComboBox as ComboBox 
    Public Property Set ComboBox (pctlComboBox as ComboBox)
       set myComboBox = pctlComboBox
       myComboBox.OnDblClick = "[Event Procedure]"
    End Property

   Private WithEvents myTextBox as TextBox
    Public Property Set TextBox(pctltextBox as TextBox)
       set myTextBox= pctltextBox
       myTextBox.OnDblClick = "[Event Procedure]"
    End Property

Public Sub myComboBox_DblClick(intCancel As Integer)
   If Not IsNull(KeyID(myComboBox.Text)) Then 'Check that there is a record to edit
       EditFormX(myComboBox) 'EditFormX depends on the Class 
       'Some more code in here depending on the user's edit
       myComboBox.Requery
   End If
End Sub

Public Sub mytextBox_DblClick(intCancel As Integer)
   If Not IsNull(KeyID(myTextBox.Text)) Then 'Check that there is a record to edit
       EditFormX(myTextBox) 'EditFormX depends on the Class 
       'Some more code in here depending on the user's edit
       myTextBox.Requery
   End If
End Sub

回答1:

For CallByName to work, you need to ensure the following:

1) The method being called is public not private.

2) All required parameters are passed.

As such, you need to make the event handlers public (as you are now doing), and pass an additional argument to CallByName for the DblClick handers' Cancel parameter. Since you aren't doing anything with that parameter inside the methods themselves, passing just 0 will do:

CallByName Ctl.Parent, Ctl.Name + "_DblClick", 0

Update 1 - example of this working [note this proves too simple in the OP's case - see Update 2 below]

a) Create a new Access project.

b) Add a new blank form to the project, and a TextBox to the form.

c) Double click the text box's On DblClick event in the Properties window, choosing the Code Builder option if prompted.

d) Add the following code for the handler:

Private Sub Text1_DblClick(Cancel As Integer)
  MsgBox "Hello World!"
End Sub

e) Amend the method's header so that it reads Public Sub not Private Sub

f) View (open) the form, and focus the text box by clicking inside it.

g) Go back into the VBA editor, and add a new standard module.

h) Add the following sub-routine to the module:

Sub Test()
  Dim Ctl As Access.Control
  Set Ctl = Screen.ActiveControl
  CallByName Ctl.Parent, Ctl.Name + "_DblClick", VbMethod, 0
End Sub

i) With the caret inside the Test routine, press F5 or click the Run button

On this, the 'Hello World' message appears for me.

Update 2

With the use of WithEvents now explicit, a demo of something that may work in your situation:

1) In Access, create a new database and add a blank form to it.

2) Add a text box and a combo box to the form, and call then txtTest and cboTest; next, add three command buttons, calling them cmdCreateControllers, cmdDestroyControllers and cmdExecuteController respectively, and setting their captions to 'Create controllers', 'Destroy controllers' and 'Execute controller'. Also set cmdDestroyControllers and cmdExecuteController's Enabled properties to False.

3) In the VBA editor, add a class module, rename it IController, and add the following code:

Option Explicit

Sub Execute()
End Sub

This is our interface type (i.e., abstract class definition).

4) Via Tools|References..., add a reference to 'Microsoft Scripting Runtime', of whose Dictionary class we will shortly be using.

5) Add a standard module, and the following code to it:

Option Explicit

Private mControllers As New Scripting.Dictionary

Sub RegisterController(Obj As Object, Controller As IController)
  mControllers.Add Obj, Controller
End Sub

Sub UnregisterController(Obj As Object)
  mControllers.Remove Obj
End Sub

Function GetController(Obj As Object) As IController
  Set GetController = mControllers(Obj)
End Function

Function IController_Initialize(Controller As IController, _
  OldObj As Object, NewObj As Object) As Object
  If Not (NewObj Is OldObj) Then
    If Not (OldObj Is Nothing) Then UnregisterController OldObj
    If Not (NewObj Is Nothing) Then RegisterController NewObj, Controller
  End If
  Set IController_Initialize = NewObj
End Function

The last function here is a helper one for IController implementations. Let's now create a couple -

6) Add another class module, rename it MyTextBoxController, and add the following code:

Option Explicit

Implements IController

Private WithEvents mTextBox As Access.TextBox

Property Set TextBox(NewValue As Access.TextBox)
  Set mTextBox = IController_Initialize(Me, mTextBox, NewValue)
  If Not (mTextBox Is Nothing) Then mTextBox.OnDblClick = "[Event Procedure]"
End Property

Private Sub mTextBox_DblClick(Cancel As Integer)
  IController_Execute
End Sub

Private Sub IController_Execute()
  MsgBox "Hello from the example text box controller!"
End Sub

7) Add another class module, rename it MyComboBoxController, and add the following code:

Option Explicit

Implements IController

Private WithEvents mComboBox As Access.ComboBox

Property Set ComboBox(NewValue As Access.ComboBox)
  Set mComboBox = IController_Initialize(Me, mComboBox, NewValue)
  If Not (mComboBox Is Nothing) Then mComboBox.OnDblClick = "[Event Procedure]"
End Property

Private Sub mComboBox_DblClick(Cancel As Integer)
  IController_Execute
End Sub

Private Sub IController_Execute()
  MsgBox "Hello from the example combo box controller!"
End Sub

8) Go back the form and handle cmdCreateControllers' Click event as thus:

Option Explicit

Private mTextBoxController As MyTextBoxController, mComboBoxController As MyComboBoxController

Private Sub cmdCreateControllers_Click()
  If mTextBoxController Is Nothing Then Set mTextBoxController = New MyTextBoxController
  Set mTextBoxController.TextBox = txtTest
  If mComboBoxController Is Nothing Then Set mComboBoxController = New MyComboBoxController
  Set mComboBoxController.ComboBox = cboTest
  cmdDestroyControllers.Enabled = True
  cmdExecuteController.Enabled = True
End Sub

9) Handle the other two buttons' Click events like this:

Private Sub cmdDestroyControllers_Click()
  cmdCreateControllers.SetFocus
  cmdDestroyControllers.Enabled = False
  cmdExecuteController.Enabled = False
  Set mTextBoxController.TextBox = Nothing
  Set mComboBoxController.ComboBox = Nothing
End Sub

Private Sub cmdExecuteController_Click()
  Dim Name As String
  Name = InputBox("Enter the name of the control whose controller you want to execute:")
  If Name = "" Then Exit Sub
  GetController(Me.Controls(Name)).Execute ' add error handling as desired!
End Sub

10) Open the form, and double click either the text box or the combo box - nothing should happen.

11) Click Create Controllers, and double click again: a message box should show.

12) Click Execute Controller, and enter txtTest: a message box should again show.

13) Unhook the custom event sinks and unregister them as object controllers by clicking Destroy Controller; having done that, double clicking either of the subject controls should once more do nothing.

回答2:

I've found the following works for the "zoomable" boxes, where the name of the relevant class and the textbox control within it are always the same.

Within the form:

Public mclsZoomText As appZoomText

and on entry to the control:

set mclsZoomtext = new appZoomtext
Set mclsZoomText.pTextBox = ActiveControl

Within the class:

    Public WithEvents myTextBox As Access.TextBox
    Public Sub myTextBox_DblClick(intCancel As Integer)       
      OpenZoomForm
    End Sub

and when the zoom option is invoked from the menu:

Public Function OnActionZoom() As Boolean

Dim ctl As Control
dim intX as Integer

Set ctl = GetCurrentControl
'GetCurrentControl returns the current Control object on a form or subform 

Call ctl.Parent.mclsZoomText.myTextBox_DblClick(intX)

OnActionZoom = True

End Function

For the more complex case this answer is excellent.