Creating a form inside a classmodule: WithEvents not picking up events

[wadiohead]

I know I'm performing a task that, well, seems to lack sense, but for what I'm doing and how I need to deploy it, it would be useful if I could get this to work.

Inside a class module, I'm creating a simple form. So far, so good. The form is created.

But when I try to attach a withevent to a command button click in this newly created form, it simply will not register, no matter how much hair I pull out of my head.

A simplified version of the code that creates the form in the class module looks like this:


Dim WithEvents cmdEvent as CommandButton
Const TPI = 1400

Public Sub PasswordForm(ServerName As String)

Dim frmPW As Form
Dim strFrmName As String

Dim ctlCmd_OK As Control



Set frmPW = CreateForm(, "")
With frmPW
strFrmName = .Name
.Caption = ServerName & " Logon"
End With

Set ctlCmd_OK = CreateControl(frmPW.Name, acCommandButton)
With ctlCmd_OK
.Caption = "OK"
.Left = 0.5417 * TPI
.Top = 1.25 * TPI
.Width = 0.7083 * TPI
.Height = 0.2917 * TPI
.Default = True
.Name = "cmdOK"
End With

DoCmd.OpenForm frmPW.Name, acNormal

Set cmdEvent = Forms(strFrmName).Controls("txtLogon")

cmdEvent.OnClick = "[Event Procedure]"
End Sub

Private Sub cmdEvent_Click()
MsgBox "hi"
End Sub



Calling the class module method as here:

Dim NotWorking as ClassModuleName
Set notworking = new classmodulename
Notworking.PasswordForm "blah"



And yet, no matter how many times I click on that stupid OK button, nothing happens.

I would be VERY grateful for any help.

-David

PS I've also set the object (NotWorking) to a public, as well as the WithEvents call (cmdEvent). Sigh.

[xCav8r]

Try starting with this: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaac11/html/acmthCreateEventProc_HV05186729.asp


Function ClickEventProc() As Boolean
Dim frm As Form, ctl As Control, mdl As Module
Dim lngReturn As Long
On Error GoTo Error_ClickEventProc
' Create new form.
Set frm = CreateForm
' Create command button on form.
Set ctl = CreateControl(frm.Name, acCommandButton, , , , _
1000, 1000)
ctl.Caption = "Click here"
' Return reference to form module.
Set mdl = frm.Module
' Add event procedure.
lngReturn = mdl.CreateEventProc("Click", ctl.Name)
' Insert text into body of procedure.
mdl.InsertLines lngReturn + 1, vbTab & "MsgBox ""Way cool!"""
ClickEventProc = True
Exit_ClickEventProc:
Exit Function
Error_ClickEventProc:
MsgBox Err & " :" & Err.Description
ClickEventProc = False
Resume Exit_ClickEventProc
End Function


Then you can stick it in a class module (just make sure you keep the event procedure for the button in the class module for its form in accordance with the procedure above.)

Standard Module:

Option Compare Database
Option Explicit
Sub dostuff()
Dim AccessOfEvil As New clsAxis
With AccessOfEvil
.Name = "!Bahad.Name"
.NewForm
.ClickEventProc
End With
End Sub


Class Module (clsAxis):

Option Compare Database
Option Explicit
Private mstrFormName As String
Private Sub Class_Initialize()
mstrFormName = NewName("Form")
End Sub
Public Property Get Name() As String
Name = mstrFormName
End Property
Public Property Let Name(ByVal FormName As String)
If HasInvalidCharacters(FormName) Then
'Don't use that!!!
ElseIf FormExists(FormName) Or Len(FormName) > 64 Then
mstrFormName = NewName(FormName)
End If
End Property
Private Function FormExists(ByVal FormName As String) As Boolean
Dim obj As AccessObject
For Each obj In Application.CurrentProject.AllForms
If obj.Name = FormName Then
FormExists = True
End If
Next obj
End Function
Public Sub NewForm()
Dim frmNew As Form
Dim strTempFormName As String
Set frmNew = CreateForm
strTempFormName = frmNew.Name
With DoCmd
.Save acForm, strTempFormName
.Close acForm, strTempFormName, acSaveYes
.Rename mstrFormName, acForm, strTempFormName
End With
End Sub
Private Function HasInvalidCharacters(ByVal FormName As String) As Boolean
' 64 characters or less
' prohibited: . ! ` [ ]
' can't start with leading spaces
If InStr(1, FormName, ".", vbTextCompare) <> 0 _
Or InStr(1, FormName, "!", vbTextCompare) <> 0 _
Or InStr(1, FormName, "`", vbTextCompare) <> 0 _
Or InStr(1, FormName, "[", vbTextCompare) <> 0 _
Or InStr(1, FormName, "]", vbTextCompare) <> 0 _
Or Left(FormName, 1) = " " Then
HasInvalidCharacters = True
End If
End Function
Private Function NewName(ByVal FormName As String) As String
Dim intLengthOfSuffix As Integer
Dim intLengthOfFormName As Integer
Dim intSuffix As Integer
Dim strNameToTry As String

intSuffix = 0

Do
intSuffix = intSuffix + 1
strNameToTry = FormName & CStr(intSuffix)
Loop Until FormExists(strNameToTry) = False
intLengthOfSuffix = Len(CStr(intSuffix))
intLengthOfFormName = Len(FormName)

If intLengthOfFormName + intLengthOfSuffix > 64 Then
FormName = Left(FormName, intLengthOfFormName - intLengthOfSuffix)
End If

NewName = FormName & CStr(intSuffix)
End Function
Public Sub ClickEventProc()
Dim frm As Form, ctl As Control, mdl As Module
Dim lngReturn As Long
' Create new form.
If Not FormExists(mstrFormName) Then NewForm
' Create command button on form.
DoCmd.OpenForm mstrFormName, acDesign
Set frm = Forms(mstrFormName)
Set ctl = CreateControl(frm.Name, acCommandButton, , , , _
1000, 1000)
ctl.Caption = "Click here"
' Return reference to form module.
Set mdl = frm.Module
' Add event procedure.
lngReturn = mdl.CreateEventProc("Click", ctl.Name)
' Insert text into body of procedure.
mdl.InsertLines lngReturn + 1, vbTab & "MsgBox ""Way cool!"""
DoCmd.Save acForm, mstrFormName
DoCmd.OpenForm mstrFormName, acNormal
End Sub


I'm tired, or I wouldn't have made inserted such a poorly hacked procedure into a class (perhaps I'll clean it up this weekend), but it demonstrates how to do it well enough. The other things I stuck in there might be more helpful for understanding class modules. Anyway, HTH!

[Norie]

Don;t know if it's at all relevant but this is the code I use to create a standard form, with a little bit of code for some of the buttons.

Public Sub NewForm()
'creates a new standard form based on a blank template
'asking user if they want standard buttons such as help & back
'and if they want any other additional buttons of two standard
'sizes - big 6cmx1cm and small 3cmX0.667cm
Dim frm As Form, ctl As Control, mdl As Module
Dim NoControls%
Dim I%
Dim X%, Y%
Dim lngReturn As Long
Dim R$
Y = 0
X = 0
Set frm = CreateForm(, "Blank Form")
frm.Caption = InputBox("What caption do you want for the the form?", "Form Caption")

Set ctl = CreateControl(frm.Name, acLine, , , , 0, 11 * TW, 20 * TW)
ctl.SpecialEffect = 3
If MsgBox("Do you want a back button?", vbYesNo + vbQuestion, "Back button?") = vbYes Then
R$ = InputBox("Enter name of form to go back to", "Back form")
Set ctl = CreateControl(frm.Name, acCommandButton, _
, , , 1 * TW, 11.2 * TW, 3 * TW, 0.667 * TW)
ctl.Caption = "&Back"
ctl.Name = "btnBack"

Set mdl = frm.Module
lngReturn = mdl.CreateEventProc("Click", ctl.Name)
mdl.InsertLines lngReturn + 1, vbTab & "Swapforms " & Chr(34) & R$ & Chr(34) & ", Me.FormName"
End If
If MsgBox("Do you want a help button?", vbYesNo + vbQuestion, "Help button?") = vbYes Then
Set ctl = CreateControl(frm.Name, acCommandButton, _
, , , 16 * TW, 11.2 * TW, 3 * TW, 0.667 * TW)
ctl.Caption = "&Help"
ctl.Name = "btnHelp"
Set mdl = frm.Module
lngReturn = mdl.CreateEventProc("Click", ctl.Name)

mdl.InsertLines lngReturn + 1, vbTab & "Msgbox " & Chr(34) & "There is no help file currently available" & Chr(34) & ", vbInformation, ""Help"""
End If

NoControls = InputBox("How many large buttons do you want on the new form?", "Large buttons")
For I = 1 To NoControls
Set ctl = CreateControl(frm.Name, acCommandButton, _
, , , X, Y, 6 * TW, 1 * TW)
ctl.Name = "btnLNew" + Trim(Str(I))
X = X + TW * 6.5
If X > (TW * 14) Then X = 0: Y = Y + TW * 1.5
Next I
X = 0
Y = Y + TW * 1.5
NoControls = InputBox("How many small buttons do you want on the new form?", "Small buttons")
For I = 1 To NoControls
Set ctl = CreateControl(frm.Name, acCommandButton, _
, , , X, Y, 3 * TW, 0.667 * TW)
ctl.Name = "btnSNew" + Trim(Str(I))
X = X + TW * 3.5
If X > (TW * 17) Then X = 0: Y = Y + TW * 1.5
Next I
MsgBox "Back & Help buttons have been created with standard code associated with them!", vbInformation, "Finished"
DoCmd.Maximize
End Sub

[wadiohead]

Thanks Norie and xcav8r, that'll solve my problem perfectly--it never occurred to me that there would be an insert procedure function. Really very kind of both of you. And very silly of you to apologize xCav8r.

I'm still not exactly sure why the WithEvents doesn't work in this case, it seems like it should, but I'm not one to look beyond a working solution.

Thanks again,

David

[xCav8r]

Here's some reading that you might find helpful for your understanding of what's going on with the WithEvents jazz: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/modcore/html/deovrcreatingeventproceduresforbuiltineventsbyusingwitheventskeyword.asp

[wadiohead]

Thanks, xCav8r. I had already looked through MSDN's events. I'm still not sure why my original code didn't work, but, well, oh well.

I do have another problem now... Protection. I hadn't really thought of it being a problem, but of course, when I slap protection on my project, the inserting module stuff fails. Anyone have any ideas?