In excel, I have an userForm with checkBox dynamically created from a list
on initialize, I call a sub to affect a click event to my checkbox.
I have then a classmodule call MyEvents in wich I declare click event for check box.
Here is the class module MyEvents :
Option Explicit
Public WithEvents chkGroup As MSForms.CheckBox
Private Sub chkGroup_Click()
Debug.Print "chkGroup_Click -----> " & chkGroup.Caption
End Sub
Here is the sub on userForm :
Private Sub initCheckBox(chanelList As Variant)
Dim myEvent As MyEvents
Dim chkBox As Collection
Dim n As Long, j As Integer, i As Integer
n = Application.CountA(chanelList)
Dim checkBoxChanel() As MSForms.CheckBox
ReDim checkBoxChanel(n) As MSForms.CheckBox
n = 1
j = 1
i = 1
Set chkBox = New Collection
chkBoxNum = 0
For Each chanel In chanelList
Set myEvent = New MyEvents
Set checkBoxChanel(n) = Frame1.Controls.Add("Forms.CheckBox.1", "chkBoxChanel" & n)
Set myEvent.chkGroup = Frame1.Controls("chkBoxChanel" & n)
chkBox.Add myEvent
With checkBoxChanel(n)
.Top = j
.Left = i
.Caption = chanel
.AutoSize = True
.Value = True
.Enabled = False
End With
n = n + 1
i = i + 80
If n Mod 3 = 0 Then
j = j + 20
i = 1
End If
Next
End Sub
Can someone explain me why clickevent is diffused on initialising. Is it the normal behavior ?
okay, I've found the trick. Setting check box value to true is like clicking on check box ! to avoid this, I just have to affect event after setting value to true. Thanks to all for you comment and answers
Related
I have a userform with dynamic checkboxes(programmed)
Below is my code
Dim Rows As Integer
Dim toppart As Integer
Dim Opt As Variant
Dim x As Integer
On Error Resume Next
toppart = 20
UpdateRow = Application.WorksheetFunction.CountA(ActiveSheet.Range("C3:CU3"))
For x = 3 To UpdateRow
Set Opt = Te.Controls.Add("Forms.CheckBox.1", "CheckBox" & x, True)
Opt.Caption = ActiveSheet.Cells(x, "C").Value
Opt.Width = 70
Opt.Height = 18
Opt.Left = 18
Opt.Top = toppart
toppart = toppart + 20
Next
I know if the checkboxes were set via the controls my code will look something like this:
If (CheckBox1.Value = False) Or (CheckBox2.Value = False) Then
MsgBox "You must select alteast 2 checkboxes", vbCritical
But when the checkboxes are dynamically created I can't think of a efficient way to do it. Please any suggestions or Help is very much appreciated, thanks.
Untested, but you can probably loop the controls on your form, check if each is a checkbox, if it is, query it's .Value and tally the total number of checkboxes which are "checked. If that number is LTE 1, then you raise your warning/MsgBox:
Dim checked as Long
Dim ctrl as Object
For Each ctrl in Me.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl.Value = True Then
checked = checked + 1
End If
End If
Next
If checked <= 1 Then
MsgBox "You must select alteast 2 checkboxes", vbCritical
Exit Sub
End If
I am trying to add multiple spin button with each of them linked to different sets of cells that have some values assigned to them. i have tried adding the controls and use a class module to add the event handler procedure to them but to no avail. any help would be appreciated.
Dim spinArray() As New Class1
Private Sub UserForm_Initialize()
Dim i As Long
Dim quantspin As MSForms.SpinButton
subassy_break.Height = pnum1 * 70
subassy_break.Width = 500
With Label_Var
.Top = 15
.Left = subassy_break.Width - (Label_Var.Width + 15)
.Caption = msg
.AutoSize = True
.Font.Bold = True
End With
With UserForm
For i = 1 To pnum1
Set quantspin = Me.Controls.Add("Forms.spinbutton.1", "Quantity_Count_" & i)
With quantspin
.Min = 0
.SmallChange = 1
.Max = 1
.Left = 200
.Top = subassy_break.height- pnum1*20
End With
Next i
End With
End Sub
also the new class module that i have added is
Public WithEvents spinevents As MSForms.SpinButton
Private Sub spinevents_change()
For i = 1 To pnum1
Cells(userow + i, usecol).Value = spinevents.Value
Next i
End Sub
This should help you figure it out:
clsSpin
Public WithEvents spinevents As MSForms.SpinButton
Public TargetCell As Range '<<the cell to operate on
Private Sub spinevents_change()
TargetCell.Value = spinevents.Value
End Sub
UserForm (simplified to show the relevant parts)
Dim spinners As Collection '<<< holds your clsSpin objects
Private Sub UserForm_Initialize()
Dim i As Long, s As clsSpin, quantspin
Set spinners = New Collection
For i = 1 To 5
Set quantspin = Me.Controls.Add("Forms.spinbutton.1", "Quantity_Count_" & i)
With quantspin
.Min = 0
.SmallChange = 1
.Max = 100
.Left = 20 * i
.Top = 50
End With
'create a new instance of the class, set some properties
' and add it to the collection
Set s = New clsSpin
Set s.spinevents = quantspin
Set s.TargetCell = ThisWorkbook.Sheets(1).Cells(i, 1)
spinners.Add s
Next i
End Sub
I am writing a VBA application in Excel. I have a Userform that dynamically builds itself based upon the data contained in one of the worksheets.
All of the code that creates the various comboboxes, textboxes and labels is working.
I created a class module to trap OnChange events for the Comboboxes, and again this works as expected.
Now I have a need to trap OnChange events for some of the textboxes, so I created a new class module modelled on that for the comboboxes to trap the events.
Public WithEvents tbx As MSForms.TextBox
Sub SetTextBox(ctl As MSForms.TextBox)
Set tbx = ctl
End Sub
Public Sub tbx_Change()
Dim LblName As String
MsgBox "You clicked on " & tbx.Name, vbOKOnly
End Sub
The message box is just so that I can confirm it works before I go further.
The problem I'm getting is in the UserForm code module:
Dim TBox As TextBox
Dim tbx As c_TextBoxes
'[...]
Set TBox = lbl
Set tbx = New c_TextBoxes
tbx.SetTextBox lbl
pTextBoxes.Add tbx
This throws up a type mismatch error at Set TBox=lbl. It's the exact same code that works fine for the ComboBox, just with the variables given approriate names. I've stared at this for 2 hours.
Anyone got any ideas? Thanks for any pointers.
Edit - Here's the full userform module that I'm having trouble with:
Private Sub AddLines(FrameName As String, PageName As String)
Dim Counter As Integer, Column As Integer
Dim obj As Object
Dim CBox As ComboBox
Dim cbx As c_ComboBox
Dim TBox As TextBox
Dim tbx As c_TextBoxes
Dim lbl As Control
Set obj = Me.MultiPage1.Pages(PageName).Controls(FrameName)
If pComboBoxes Is Nothing Then Set pComboBoxes = New Collection
If pTextBoxes Is Nothing Then Set pTextBoxes = New Collection
For Counter = LBound(Vehicles) To UBound(Vehicles)
For Column = 1 To 8
Select Case Column
Case 1
Set lbl = obj.Add("Forms.Label.1", "LblMachine" & FrameName & Counter, True)
Case 2
Set lbl = obj.Add("Forms.Label.1", "LblFleetNo" & FrameName & Counter, True)
Case 3
Set lbl = obj.Add("Forms.Label.1", "LblRate" & FrameName & Counter, True)
Case 4
Set lbl = obj.Add("Forms.Label.1", "LblUnit" & FrameName & Counter, True)
Case 5
Set lbl = obj.Add("Forms.ComboBox.1", "CBDriver" & FrameName & Counter, True)
Case 6
Set lbl = obj.Add("Forms.Label.1", "LblDriverRate" & FrameName & Counter, True)
Case 7
Set lbltbx = obj.Add("Forms.TextBox.1", "TBBookHours" & FrameName & Counter, True)
Case 8
Set lbl = obj.Add("Forms.Label.1", "LblCost" & FrameName & Counter, True)
End Select
With lbl
Select Case Column
Case 1
.Left = 1
.Width = 60
.Top = 10 + (Counter) * 20
.Caption = Vehicles(Counter).VType
Case 2
.Left = 65
.Width = 40
.Top = 10 + (Counter) * 20
.Caption = Vehicles(Counter).VFleetNo
Case 3
.Left = 119
.Width = 50
.Top = 10 + (Counter) * 20
.Caption = Vehicles(Counter).VRate
Case 4
.Left = 163
.Width = 30
.Top = 10 + (Counter) * 20
.Caption = Vehicles(Counter).VUnit
Case 5
.Left = 197
.Width = 130
.Top = 10 + (Counter) * 20
Set CBox = lbl 'WORKS OK
Call CBDriver_Fill(Counter, CBox)
Set cbx = New c_ComboBox
cbx.SetCombobox CBox
pComboBoxes.Add cbx
Case 6
.Left = 331
.Width = 30
.Top = 10 + (Counter) * 20
Case 7
.Left = 365
.Width = 30
.Top = 10 + (Counter) * 20
Set TBox = lbl 'Results in Type Mismatch
Set tbx = New c_TextBoxes
tbx.SetTextBox TBox
pTextBoxes.Add tbx
Case 8
.Left = 400
.Width = 30
.Top = 10 + (Counter) * 20
End Select
End With
Next
Next
obj.ScrollHeight = (Counter * 20) + 20
obj.ScrollBars = 2
End Sub
And here's the c_Combobox class module:
Public WithEvents cbx As MSForms.ComboBox
Sub SetCombobox(ctl As MSForms.ComboBox)
Set cbx = ctl
End Sub
Public Sub cbx_Change()
Dim LblName As String
Dim LblDriverRate As Control
Dim i As Integer
'MsgBox "You clicked on " & cbx.Name, vbOKOnly
LblName = "LblDriverRate" & Right(cbx.Name, Len(cbx.Name) - 8)
'MsgBox "This is " & LblName, vbOKOnly
'Set obj = Me.MultiPage1.Pages(PageName).Controls(FrameName)
Set LblDriverRate = UFBookMachines.Controls(LblName)
For i = LBound(Drivers) To UBound(Drivers)
If Drivers(i).Name = cbx.Value Then LblDriverRate.Caption = Drivers(i).Rate
Next
End Sub
And finally, here's the c_TextBoxes class module:
Public WithEvents tbx As MSForms.TextBox
Sub SetTextBox(ctl As MSForms.TextBox)
Set tbx = ctl
End Sub
Public Sub tbx_Change()
Dim LblName As String
'Does nothing useful yet, message box for testing
MsgBox "You clicked on " & tbx.Name, vbOKOnly
End Sub
After some quick testing, I am able to reproduce your error if I declare TBox as TextBox. I do not get an error if I declare TBox as MSForms.TextBox. I would recommend declaring all your TextBox variables with the MSForms qualifier.
Test code is situated similar to yours. I have a MultiPage with a Frame where I am adding a Control.
Private Sub CommandButton1_Click()
Dim obj As Object
Set obj = Me.MultiPage1.Pages(0).Controls("Frame1")
Dim lbl As Control
Set lbl = obj.Add("Forms.TextBox.1", "txt", True)
If TypeOf lbl Is TextBox Then
Debug.Print "textbox found1" 'does not execute
End If
If TypeOf lbl Is MSForms.TextBox Then
Debug.Print "textbox found2"
Dim txt1 As MSForms.TextBox
Set txt1 = lbl 'no error
End If
If TypeOf lbl Is MSForms.TextBox Then
Debug.Print "textbox found3"
Dim txt As TextBox
Set txt = lbl 'throws an error
End If
End Sub
I am not sure why the qualifier is needed for TextBox and not ComboBox. As you can see above, a good test for this is the If TypeOf ... Is ... Then to test which objects are which types. I included the first block to show that lbl is not a "bare" TextBox, but, again, I have no idea why that is. Maybe there is another type of TextBox out there that overrides the default declaration?
I am using a spin button to cycle through dates of a phase. When I call an item from a collection called customtextboxcollection with its index value, I get an "Object Required" error. Both the spin button and the text box whose value changes are dynamically created controls displayed on a UserForm called UserForm1.
The sub to create the items in customtextbox collection run before the spin button is clicked:
Dim customtextboxcollection As Collection
Dim spinbuttoncollection As Collection
Public Sub ComboBox1_Click() 'When a person is selected to enter hours for an employee from a combobox, it triggers the creation of the controls
Sheet1.Activate
CommandButton1.Enabled = True 'Enable the OK and Apply buttons when personnel title is selected.
UserForm1.Label2.Visible = True
UserForm1.ratebox.Visible = True
QuantityLabel.Visible = True
quantitybox.Visible = True
'The variables below are to access the table where I store saved information regarding the project phases I will add hours to.
Dim counter As Integer
counter = 6 'The index of the first row for phases
Dim phasecolumn As Integer
phasecolumn = 3 'The index of the column containing the phases
Dim checkboxnumber As Integer
checkboxnumber = 1 'This is the number needed to distinguish between the checkboxes that appear/disappear.
phasestartcolumn = 4
phaseendcolumn = 5
Dim customtextboxHandler As cCustomTextBoxHandler
Set customtextboxcollection = New Collection 'Sets the previously created collection
Dim spinbuttonHandler As cSpinButtonHandler 'This is my spin button handler class
Set spinbuttoncollection = New Collection 'Sets the previously created collection
'This Do-Loop locates a row on the table with saved information
Do
If (Sheet3.Cells(savedpersonnelrow, savedpersonnelcolumn) = ComboBox1.Value) Then
storagerow = savedpersonnelrow
lastcomboboxvalue = ComboBox1.Value
Exit Do
End If
savedpersonnelrow = savedpersonnelrow + 1
Loop Until (savedpersonnelrow = 82)
Sheet1.Activate
'These sections create the controls depending on the number of phases saved.
Set spin = UserForm1.Controls.Add("Forms.SpinButton.1")
With spin
.name = "SpinButton" & checkboxnumber
.Left = 365
.Top = topvalue + 6
.Height = 15
.Width = 40
'.Value = Sheet3.Cells(storagerow, savedphasecolumn + checkboxnumber)
'Sheet1.Activate
Dim phasestart As Date
phasestart = Sheet1.Cells(counter, phasestartcolumn).Value
Dim phaseend As Date
phaseend = Sheet1.Cells(counter, phaseendcolumn).Value
spin.Min = phasestart
spin.Max = phaseend
spin.Orientation = fmOrientationVertical
'Do
'.AddItem Format(phasestart, "mmm-yy")
'phasestart = DateAdd("m", 1, phasestart)
'Loop Until (Month(phaseend) = Month(phasestart) And Year(phaseend) = Year(phasestart))
Set spinbuttonHandler = New cSpinButtonHandler
Set spinbuttonHandler.spin = spin
spinbuttoncollection.Add spinbuttonHandler
End With
Set ctext = UserForm1.Controls.Add("Forms.TextBox.1")
With ctext
.name = "CustomTextbox" & checkboxnumber
.Left = 470
.Top = topvalue + 6
.Height = 15
.Width = 40
.Value = phasestart
Set customtextboxHandler = New cCustomTextBoxHandler
Set customtextboxHandler.ctext = ctext
customtextboxcollection.Add customtextboxHandler
End With
topvalue = topvalue + 15
counter = counter + 1
checkboxnumber = checkboxnumber + 1
Loop Until counter = 14
End Sub
In my class called cSpinButtonHandler, I reference these customtextboxcollection object associated with it's corresponding spin button:
Public WithEvents spin As MSForms.SpinButton
Private Sub spin_Click()
UserForm1.CommandButton3.Enabled = True
End Sub
Private Sub spin_SpinDown()
x = 0
Do
x = x + 1
Loop Until spin.name = "SpinButton" & x
Dim spindate As Date
spindate = customtextboxcollection.Item(x).ctext.Value 'The error occurs here.
customtextboxcollection.Item(x).ctext.Value = DateAdd("m", -1, spindate)
End Sub
Why is this reference generating an error? What is the correct way to reference it?
This is not an answer to your real question, but a suggestion for an alternate approach which might be easier to manage.
Instead of using two separate collections and two different classes, you could create a single class which would handle each pair of controls (one spin and one text box). That would be easier to handle in terms of hooking events between each pair.
clsSpinText:
Option Explicit
Public WithEvents txtbox As MSForms.TextBox
Public WithEvents spinbutn As MSForms.SpinButton
Private Sub spinbutn_Change()
'here you can refer directly to "txtbox"
End Sub
Private Sub txtbox_Change()
'here you can refer directly to "spinbutn"
End Sub
When adding your controls create one instance of clsSpinText per pair, and hold those instances in a single collection.
I have UserForm4 which contains CheckBox1...19 and also OptionButton1...3, along with TextBox1, CommandButton1, 2.
When OptionButton 1 = True I want to loop through all CheckBoxes and set each to True.
The error I get states "Cannot find object" and i = 21, n = 23. How are they getting that high, when I only have 19 CheckBoxes?
Thanks!
Private Sub OptionButton1_Click()
Dim ctrl As Control
Dim i As Integer
Dim n As Integer
n = 0
For Each ctrl In UserForm4.Controls
If TypeOf ctrl Is MSForms.CheckBox Then
n = n + 1
End If
Next ctrl
For i = 1 To n
If UserForm4.Controls("CheckBox" & i) = False Then
UserForm4.Controls("CheckBox" & i) = True
End If
Next i
End Sub
Did you create more than 19 initially and delete some? Each VBA object has a unique name. Doing this the way you are doing it is likely to cause all sorts of problems.
For example, if you create 10 CheckBoxes and delete 8 of them, the remaining two might be named Checkbox8 and Checkbox9. So your loop will not hit them at all.
Also, why not do something like the following:
Private Sub OptionButton1_Click()
Dim ctrl As Control
Dim i As Integer
Dim n As Integer
n = 0
For Each ctrl In UserForm4.Controls
'this will make your problem really obvious
debug.print ctrl.name
If TypeOf ctrl Is MSForms.CheckBox Then
ctrl.value = True
End If
Next ctrl
End Sub