VBE tricky question

[Ludo]

Hi,

I have a userform (frmProfileGraph) where I add some controls
programatically (see example:
http://spreadsheetpage.com/index.php/site/tip/creating_a_userform_programmatically/)
, the number of controls is depending on the number of executed test,
so this one is variable.
Thats why i want to add them programmatically and not fixed.

The controls i add are labels and checkboxes.
So far it works fine, but i want to add programatically some code for
the checkboxes when clicking on a checkbox (change event) that
depending on the TRUE / FALSE condition a routine is executed. And
here it fails.

The code for the checkboxes is added to the codemodule (see below the
Userform initialize code) , but i get an Automation error as follow:

Run-time error '-214717848(80010108)':
Automation error
The object invoked has disconnected from its clients.

I hoped to get some information by adding a errorhandler in the code,
but this isn't invoked. I get the Automation error before the
errorhandler is executed.

Here's my code:

Private Sub UserForm_Initialize()
Dim MyLabel As MSForms.Label
Dim MyCheckbox As MSForms.CheckBox
Dim i As Integer
Dim MaxWidth As Long 'max width for the labels
Const LabelOffset = 16 'offset between the different FMT test
labels
Const TopOffset = 140
'if a graph has been made before, clear the combobox
If GraphMade = True Then
Me.lbFMT_LogList.Clear
End If
If StartUp = True Then
'add labels with the FMT Test name
For i = 1 To UBound(FMT_TestNames)
Set MyLabel = Me.Controls.Add("Forms.Label.1")
With MyLabel
.Name = "lbl_TestName" & i
.Font.Bold = True
.Font.Size = 10
.Font.Name = "Tahoma"
.WordWrap = False
.Width = 102
.Height = 36
.Top = TopOffset + (i * LabelOffset)
.Left = 2
.Caption = FMT_TestNames(i)
.Visible = True
If .Width > MaxWidth Then
MaxWidth = .Width
End If
End With
Next
'add labels to place failure count in it
For i = 1 To UBound(FMT_TestNames)
Set MyLabel = Me.Controls.Add("Forms.Label.1")
With MyLabel
.Name = "lbl_Test" & i
.Font.Bold = True
.Font.Size = 10
.Font.Name = "Tahoma"
.Height = 36
.Top = TopOffset + (i * LabelOffset)
.Left = 2 + MaxWidth
.Caption = ""
.Visible = True
.Width = 20
End With
Next
'add checkbox for every FMT test and set them TRUE and invisible
For i = 1 To UBound(FMT_TestNames)
Set MyCheckbox = Me.Controls.Add("Forms.checkbox.1")
With MyCheckbox
.Name = "Checkbox" & i
.Width = 14
.Height = 10
.Top = TopOffset + (i * LabelOffset)
.Left = 45 + MaxWidth
.Visible = False
.value = True
End With
Next
'add eventcode for every checkbox
Set TempForm =
ThisWorkbook.VBProject.VBComponents.Item("frmprofilegraph")
With TempForm.CodeModule
x = .CountOfLines
For i = 1 To UBound(FMT_TestNames)
Debug.Print "checkbox" & i
On Error GoTo Errorhandler
.InsertLines x + 1, "Private Sub Checkbox" & i &
"_Change()"
.InsertLines x + 2, " if me.value=true then"
.InsertLines x + 3, " ShowFail"
.InsertLines x + 4, " else"
.InsertLines x + 5, " HideFail"
.InsertLines x + 6, " endif"
.InsertLines x + 7, "End Sub"
Next
End With
End If
With Me
.Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" &
MyChartName & ".gif")
.Image1.PictureSizeMode = fmPictureSizeModeStretch
.tbSerieNumber.SetFocus
.lblStatus.Caption = ""
End With
StartUp = False
GraphData = True
Exit Sub
Errorhandler:
Debug.Print Err.Description
Debug.Print Err.Number
Resume Next
End Sub
-------------------
Here's part of the code generated by the "add eventcode for every
checkbox" loop:

Private Sub Checkbox2_Change()
If Me.value = True Then
ShowFail
Else
HideFail
End If
End Sub
Private Sub Checkbox1_Change()
If Me.value = True Then
ShowFail
Else
HideFail
End If
End Sub

...... until

Private Sub Checkbox21_Change()
If Me.value = True Then
ShowFail
Else
HideFail
End If
End Sub

------

Anyone who can help me solve this problem?
I realy want it up and running, its also a chalenge.

Thanks in advance,

Regards,
Ludo

 

[ABS]

The controls i add are labels and checkboxes.

So far it works fine, but i want to add programatically some code for
the checkboxes when clicking on a checkbox (change event) that
depending on the TRUE / FALSE condition  a routine is executed. And
here it fails.

Ludo,
Seems to me I recall having to do something similar and I found that
when I got to that True/False condition I got the same kind of
errors. Makes sense cause you're trying to refer to objects that
don't exist yet. I solved by creating all the objects I would need,
then messing around with the Visible property. So, if condition is
True then controls & labels 1 thru 4 visible, if False, controls &
labels 5 thru 8 visible. Wise to always declare one set visible and
the other one invisible otherwise you can get a mess and not know
why. Or declare them all invisible until your True/False sets one
group to visible.
Yeah, you can do it.
ABS

 

[Peter T]

Not possible to do what you're doing, ie event code to the form duiring
runtime from itself. But there's a much easier way, try this

Add a Class module named
Paste the following into the class module and form module as indicated
Run the form and press click some boxes

' code in class named "clsChkBoxEvents"
Public WithEvents cbx As MSForms.CheckBox
Public idxR As Long, idxC As Long

Private Sub cbx_Change()
If cbx Then
cbx.Parent.ShowFail idxR, idxC
Else

cbx.Parent.HideFail idxR, idxC
End If

End Sub
''' end class clsChkBoxEvents

' code in a userform

Private maCBX(1 To 20) As clsChkBoxEvents
Private Sub UserForm_Initialize()
Dim i As Long, j As Long, n As Long
Dim ctr As MSForms.Control
Const cWd As Single = 45, cHt As Single = 18

For i = 0 To 4
For j = 0 To 3
Set ctr = Me.Controls.Add("Forms.Checkbox.1")
With ctr
.Left = 3 + j * (cWd + 9)
.Top = 3 + i * (cHt + 9)
.Width = cWd
.Height = cHt
.Caption = "CB " & i + 1 & " : " & j + 1
End With
n = n + 1
Set maCBX(n) = New clsChkBoxEvents
Set maCBX(n).cbx = ctr
maCBX(n).idxR = i + 1
maCBX(n).idxC = j + 1
Next
Next
End Sub

Public Sub ShowFail(r As Long, c As Long)
MsgBox "ShowFail " & r & " " & c
End Sub
Public Sub HideFail(r As Long, c As Long)
MsgBox "HideFail " & r & " " & c
End Sub

''''end userform code

Regards,
Peter T