VBA - Trapping events on dynamically created Textbox - vba

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?

Related

How to capture event of multiple Dynamic control in VBA

From a previous post I learned a way to populate a userform with a grid of textboxes:
Dim Grid(1 To 10, 1 To 5) As MSForms.TextBox
Private Sub UserForm_Initialize()
Dim x As Long
Dim y As Long
For x = 1 To 10
For y = 1 To 5
Set Grid(x, y) = Me.Controls.Add("Forms.Textbox.1")
With Grid(x, y)
.Name = "TextBox_" & x & "_" & y
.Width = 50
.Height = 20
.Left = y * .Width
.Top = x * .Height
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
End With
Next y
Next x
End Sub
Now, I need to run certain code when I change the contents of any textbox in columns 5 and 6. But since the textbox won't exist until after Initialize is run, their Change events don't exist either.
So I need to either:
Write the change events in advance, since I know the names of the textboxes in advance.
Use an event that will trigger whenever I click any textbox, and be able to identify the textbox in question.
If the only way to do this is by using a class module, please explain it carefully, since I've never actually used one.
EDIT: The answers from #TinMan and #Storax work a little too well. The code reacts to every keystroke in the textbox, but I really need to wait until the user is finished typing. There's no "Exit" event for the textbox when it's in the class module. Any thoughts?
You'll need to create a class to listen for the changes.
Class: TextBoxListener
Public WithEvents TextBox As MSForms.TextBox
Public UserForm As Object
Private Sub TextBox_Change()
UserForm.TextBoxGridChange TextBox
End Sub
Userform
With a few modifications you can use the Grid() to hold the TextBoxListeners references.
Option Explicit
Private Grid(1 To 10, 1 To 5) As New TextBoxListener
Public Sub TextBoxGridChange(TextBox As MSForms.TextBox)
Debug.Print TextBox.Value
End Sub
Private Sub UserForm_Initialize()
Dim x As Long
Dim y As Long
For x = 1 To 10
For y = 1 To 5
With Grid(x, y)
Set .TextBox = Me.Controls.Add("Forms.Textbox.1")
Set .UserForm = Me
With .TextBox
.Name = "TextBox_" & x & "_" & y
.Width = 50
.Height = 20
.Left = y * .Width
.Top = x * .Height
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
End With
End With
Next y
Next x
End Sub
Just a simple example how the class could look like for the textboxes. I named the class clsTextBoxes
Option Explicit
Public WithEvents tb As MSForms.TextBox
' just to keep track of the box in the grid
Public x As Long
Public y As Long
' Just a simple example for the change event.
' you could use x and y to tell the different textboxes apart
Private Sub tb_Change()
Debug.Print tb.Text, x, y
End Sub
You have to adjust your code in the userform like that
Option Explicit
Dim Grid(1 To 10, 1 To 5) As MSForms.TextBox
' Collection to save all the textboxes in the grid
Dim colTxt As New Collection
Private Sub UserForm_Initialize()
Dim x As Long
Dim y As Long
Dim cTxt As clsTextBoxes
For x = 1 To 10
For y = 1 To 5
Set Grid(x, y) = Me.Controls.Add("Forms.Textbox.1")
' create an new clsTextBoxes
Set cTxt = New clsTextBoxes
' save a pointer to the just created textbox
Set cTxt.tb = Grid(x, y)
' store the postion
cTxt.x = x
cTxt.y = y
' add it to the collection
colTxt.Add cTxt
With Grid(x, y)
.Name = "TextBox_" & x & "_" & y
.Width = 50
.Height = 20
.Left = y * .Width
.Top = x * .Height
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
End With
Next y
Next x
End Sub
Look at the comments for a short explanation

Microsoft ActiveX Controls

Is there a way to change the index value of a ActiveX Button that inserted onto a spreadsheet. I currently have four buttons and two are hidden and two are visible. I would like to re-order the them to not have a large gap between objects. I have some VBA code that runs when the document is opened to ensure that they are the right size and location. Because it loops through the OLEObjects Collection; it will not matter what order they are in on the spreadsheet they will always appear with a gap because of the index value in the OLE Object collection. Below is the code:
Private Sub Workbook_Open()
Application.ErrorCheckingOptions.EvaluateToError = False
ActiveWorkbook.Worksheets("SITE").Activate
Dim button As OLEObject
Dim name As String, top As Integer
top = 15
For Each button In ActiveWorkbook.Worksheets("SITE").OLEObjects
Debug.Print button.name & " " & button.ZOrder
name = button.name
If button.OLEType = xlButtonOnly And InStr(name, "btn") = 1 Then
With button
.Height = 21.75
.Width = 174.75
.Left = 1114.5
.top = top
End With
top = top + 30
End If
Next button
End Sub
If you give them proper names with an integer code in it reflecting their intended position (e.g.: "btn...01", "btn...02",...) then you could try this code (sorry for not being able to format it as code by now):
Private Sub Workbook_Open()
Application.ErrorCheckingOptions.EvaluateToError = False
ActiveWorkbook.Worksheets("SITE").Activate
Dim button As OLEObject
Dim name As String
Dim btnRnk As Long
For Each button In ActiveWorkbook.Worksheets("SITE").OLEObjects
name = button.name
If button.OLEType = xlButtonOnly And InStr(name, "btn") = 1 Then
btnRnk = CLng(Right(name,2))
With button
.Height = 21.75
.Width = 174.75
.Left = 1114.5
.top = 15 + (btnRank - 1) * 30
End With
End If
Next button
End Sub

add multiple dynamic controls to userform and assign different event handlers to them

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

Add click event to optionbutton

I have a Outlook 2013 macro where I made a form pop up. All objects (buttons, textboxes, optionsbuttons) get added by the code behind in a form.Load() event.
The form has two option buttons with yes/no. If no is pressed then some other buttons, textboxes should be disabled. My question is how to archieve that a event handler is added to these two buttons?
My programmatically added buttons:
y = y + 30
x = 230
Set btnOppYes = Me.Controls.Add("Forms.OptionButton.1", "btnOppYes")
With btnOppYes
.Caption = "Ja"
.Left = x
.Top = y
.Width = 110
.GroupName = "OppYesNo"
End With
x = x + 110
Set btnOppNo = Me.Controls.Add("Forms.OptionButton.1", "btnOppNo")
With btnOppNo
.Caption = "Nein"
.Left = x
.Top = y
.Width = 110
.GroupName = "OppYesNo"
.Value = True
End With
I tried to add this code, but with no success. There's no msgbox like "test", when I click on the option button:
Sub btnOppYes_Click()
MsgBox ("test")
End Sub
The event isn't associated with the button when its added dynamically and Outlook doesn't allow access to the CodeModule like Excel does. Here is a workaround.
Paste this code in your userform
Dim clsbtnOpp As New Class1
Private Sub UserForm_Initialize()
Dim btnOppYes As MSForms.OptionButton
Dim btnOppNo As MSForms.OptionButton
y = y + 30
x = 230
Set btnOppYes = Me.Controls.Add("Forms.OptionButton.1", "btnOppYes")
With btnOppYes
.Caption = "Ja"
.Left = x
.Top = y
.Width = 110
.GroupName = "OppYesNo"
End With
Set clsbtnOpp.btnOppYes = btnOppYes
x = x + 110
Set btnOppNo = Me.Controls.Add("Forms.OptionButton.1", "btnOppNo")
With btnOppNo
.Caption = "Nein"
.Left = x
.Top = y
.Width = 110
.GroupName = "OppYesNo"
.Value = True
End With
Set clsbtnOpp.btnOppNo = btnOppNo
End Sub
And create a new class called Class1 and paste this code in it
Public WithEvents btnOppYes As MSForms.OptionButton
Public WithEvents btnOppNo As MSForms.OptionButton
Private Sub btnOppYes_click()
MsgBox "You clicked yes"
UserForm1.TextBox1.Enabled = True
End Sub
Private Sub btnOppNo_click()
MsgBox "You clicked no"
UserForm1.TextBox1.Enabled = False
End Sub
Run your form and test. You can play around with this and tailor it to your needs

vba : why click event is diffused on initialising?

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