I created many buttons dynamically (creating schedule) and want all of them do the same thing during Click event (OnClick property).
Of course, I can create max number of buttons on the form beforehand and set them invisible, and so forth, while adding "call SomeEvent" on their Click event considering that there can be over a thousand buttons. This would be very tedious.
Therefore, simplified:
I created new class btnClass`
Public WithEvents ButtonEvent As MsForms.CommandButton
Private Sub ButtonEvent_Click()
MsgBox "hey"
End Sub
Then, in my UserForm, where I dynamically create buttons I added this (I also have Collection, to remove buttons later), in its simplified form:
Dim btnColl As Collection
Dim Buttons As New btnClass
Set btnColl = New Collection
Set Buttons = New btnClass
For i = 0 To btnCount
Set theButton = Controls.Add("Forms.CommandButton.1", "btn" & i, True)
With theButton
.Height = 17
.Caption = "btn" & i
End With
Set Buttons.ButtonEvent = theButton
btnColl.Add theButton, theButton.Name
Next i
But nothing happens when I click dynamically created buttons. What am I missing?
---UPDATED
---#FaneDuru Provided solution which worked for me
ReDim Buttons(0 To btnCount, 0 To dtDiff)
For labelcounter = 0 To dtDiff 'add date labels
Set theLabel = Controls.Add("Forms.Label.1", "lblDay" & labelcounter, True)
With theLabel
.Caption = VBA.Format(DateAdd("d", labelcounter, bDate), "d-mm-yy")
.Left = 15 + 44 * labelcounter
.BackColor = vbBlack
.Font.Bold = True
.ForeColor = vbWhite
.Height = 13
.Width = 40
.Top = 85
End With
For i = 0 To btnCount 'add time buttons
pTime = DateAdd("n", i * dur, begTime)
Set theButton = Controls.Add("Forms.CommandButton.1", "btn" & CDate(theLabel.Caption & " " & TimeValue(pTime)), True)
With theButton
.Height = 17
.Caption = VBA.Format(TimeValue(pTime), "hh:mm")
'.Caption = CDate(theLabel.Caption & " " & TimeValue(pTime))
.Left = 15 + 44 * labelcounter
.BackColor = vbGreen
.Width = 40
.Top = 100 + 18 * i
End With
Set Buttons(i, labelcounter).ButtonEvent = theButton
btnColl.Add theButton, theButton.Name
Next i
Next labelcounter
In this way, only for the last created button an event is allocated. You must declare an array of classes... I also played a little with the Left property of the newly created buttons, only to have the possibility to test their click event. Try the next approach, please:
Option Explicit
Private btnColl As New Collection
Dim Buttons() As New btnClass
Private Sub btCreate_Click()
Dim btnCount As Long, theButton As CommandButton, i As Long
btnCount = 3
ReDim Buttons(0 To btnCount)
For i = 0 To btnCount
Set theButton = Me.Controls.aDD("Forms.CommandButton.1", "btn" & i, True)
With theButton
.height = 17
.Caption = "btn" & i
.left = 50 * i
End With
btnColl.aDD theButton, theButton.Name
Set Buttons(i).ButtonEvent = theButton
Next i
End Sub
Private Sub btdelete_Click() 'buttons deletion...
Dim i As Long
For i = 1 To btnColl.count
Me.Controls.Remove (btnColl(i).Name)
Next
End Sub
Related
I'm using a form to generate 3 groups of textboxes at run time. I'm trying to achieve this: when the user click a textbox of the group "txtboxe", a FileDialog opens so the user can choose the file. When the file is picked, i wwant to get the filepath.
The problem is, usually, i would use a sub like - textboxe_Click - but i need this to work inside a existing module, and the name of each textbox is generate at run time.
So... Any ideas? I tried to use multiple times something with 'Controls' commands, but without any sucess. I manage to pick the data from each textbox, but not to control a click or change on a textbox group.
I'm providing the code below.
Dim i As Long
Dim o As Long
Dim number As Long
number = InputBox("How many docs?", "Number of docs")
Dim txtB1 As Control
Dim txtB2 As Control
For i = 1 To number
Set txtB1 = Controls.Add("Forms.Textbox.1")
With txtB1
.Name = "txtbox" & i
.Height = 16
.Width = 30
.Left = 60
.Top = 20 + (i * 40)
.Value = i
.Locked = True
.BackColor = &H80000000
End With
Set txtB2 = Controls.Add("Forms.Textbox.1")
With txtB2
.Name = "txtboxw" & i
.Height = 18
.Width = 234
.Left = 162
.Top = 20 + (i * 40)
Debug.Print .Name
End With
Set txtB3 = Controls.Add("Forms.Textbox.1")
With txtB3
.Name = "txtboxe" & i
.Height = 18
.Width = 264
.Left = 420
.Top = 20 + (i * 40)
Debug.Print .Name
End With
Next i
End Sub
Private Sub CommandButton3_Click()
Dim p As Long
For p = 1 To number
cells(p + 1, 1) = Controls("txtbox" & p).Value
cells(p + 1, 2) = Controls("txtboxw" & p).Value
cells(p + 1, 3) = Controls("txtboxe" & p).Value
Next p
End Sub ````
Registering event handlers with dynamically created controls is tricky.
But you can do it using a Class Module and WithEvent variable.
First, add the following code as a Class Module ControlEvent.
Option Explicit
Private WithEvents targetCtrl As MSForms.TextBox
Public Sub SetCtrl(new_ctrl As MSForms.TextBox)
Set targetCtrl = new_ctrl
End Sub
' You can add arbitrary event handlers for TextBox as ``targetCtrl_(Event handler name)``
Private Sub targetCtrl_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With Application.FileDialog(msoFileDialogFilePicker)
If .Show() Then
' You can access the control with the targetCtrl class variable
targetCtrl.Value = .SelectedItems(1)
End If
End With
End Sub
Then, modify your code in the UserForm to the following.
I added an array ctrls to store the ControlEvent class instances and set the created controls to the WithEvents class variables with SetCtrl method.
Private ctrls As Variant ' Added
Sub CommandButton2_Click()
Dim i As Long
Dim o As Long
Dim number As Long
number = InputBox("How many docs?", "Number of docs")
Dim txtB1 As Control
Dim txtB2 As Control
Dim txtB3 As Control
ReDim ctrls(0 To number - 1)
For i = 1 To number
Set txtB1 = Controls.Add("Forms.Textbox.1")
With txtB1
.Name = "txtbox" & i
.Height = 16
.Width = 30
.Left = 60
.Top = 20 + (i * 40)
.Value = i
.Locked = True
.BackColor = &H80000000
End With
Set txtB2 = Controls.Add("Forms.Textbox.1")
With txtB2
.Name = "txtboxw" & i
.Height = 18
.Width = 234
.Left = 162
.Top = 20 + (i * 40)
Debug.Print .Name
End With
Set txtB3 = Controls.Add("Forms.Textbox.1")
With txtB3
.Name = "txtboxe" & i
.Height = 18
.Width = 264
.Left = 420
.Top = 20 + (i * 40)
Debug.Print .Name
End With
Set ctrls(i - 1) = New ControlEvent ' Added
ctrls(i - 1).SetCtrl txtB3 ' Added
Next i
End Sub
This is the first time I've done something this complicated in UserForms using VBA. I'm not sure if this is even the correct way to do this or not.
The layout of the form
The form as a MultiPage with 5 pages.
Each Page has 5 survey questions with 4 option buttons per question (Low, Medium, High, Don't know)
4 option buttons per question are grouped
Low option button should have a value of 1, Medium 3, and High 5. Don't know should be 0 but if more
Then values from these option buttons are averaged for each page. e.g. Page 1 has 5 questions, the user selects 1. Low, 2. Low, 3. Medium, 4. Don't know, 5. High. Then the average for this page should be 2. And this average is the only one I care about and needs to be save in a sheet range (which I can do later). I don't need to store other responses.
Because the pages in the Multipage can change in the future, I created a loop to create the page dynamically based on items added in the table in a separate sheet.
Also, because questions can be added or removed for each page, I also created the labels for the question and radio buttons using the loop.
What I don't know how to do next
The layout is complete and works. What I need to do now is the following:
Make the option buttons mandatory, i.e. the user must select one option button per group.
Get the value of the option buttons for each group and calculate the average for each page
I don't know yet how to get the value of the option button when it's used in the loop. I just learnt that VBA is an event driven program, so now I'm concerned whether I can salvage the time and effort I put in creating the form using loop the following way.
In this case, I also tried to create a dictionary, store the values. But I need to store this in a collection?
Private Sub CreateAssessmentForm()
'Range variable for data from table
Dim rngTable As Range
Dim itemTable As Range
'UI forms and multipage
'Dim multiPage As MSForms.multiPage
'Labels
Dim itemLblBackground As Object
Dim itemLbl As Object
Dim lowRatingLabelBg As Object
Dim medRatingLabelBg As Object
Dim highRatingLabelBg As Object
Dim unknownRatingLabelBg As Object
Dim lowRatingLabel As Object
Dim medRatingLabel As Object
Dim highRatingLabel As Object
Dim unknownRatingLabel As Object
'Misc
Dim lblName As String
Dim lblBackground As String
Dim JobGrade As Integer
Dim itemTopPosition As Integer
Dim altBgClr As Long
'Leader Role table ID to keep track of for the Multipage tabs
Dim activeLeaderRoleId As String
'Radio buttons
Dim lowRadioButton As MSForms.OptionButton
Dim medRadioButton As MSForms.OptionButton
Dim highRadioButton As MSForms.OptionButton
Dim unknownRadioButton As MSForms.OptionButton
Set RadioDictionary = New Dictionary
'================================================================
Me.drName = Sheets("var").Range("Y2").Value
'Declaration
JobGrade = Sheets("var").Range("z2").Value
Me.dateLabel.Caption = DateValue(Now)
Me.ManagerView_SubmitAssessment.Enabled = True
'Define source range, referring to the table data range
Set rngTable = ThisWorkbook.Worksheets("LeaderRoles2").Range("leaderRoleTable2")
Set itemTable = ThisWorkbook.Worksheets("Items").Range("itemTable")
'Create a tabbed multipage to add the leader role information
Set multiPage = AssessmentForm.DriverTabs
multiPage.Font.Bold = False
multiPage.Font.Name = "Verdana"
multiPage.Font.Size = 9
multiPage.Style = fmSpecialEffectFlat
multiPage.ForeColor = RGB(0, 40, 85)
'Total page counts that may already exist
PageCount = multiPage.Pages.Count
Dim itemLabelWidth As Integer
itemLabelWidth = 325
'rngTable rows have different count than rngTable.Count if multiple columns are selected
For i = 1 To rngTable.Rows.Count
itemTopPosition = (multiPage.Height - (32 * 5)) / 2
'get leader role id
activeLeaderRoleId = rngTable.Item(i, 1).Value
If (i <= PageCount) = True Then
multiPage.Pages(i - 1).Caption = rngTable.Item(i, 2).Value
Else
multiPage.Pages.Add
Me.DriverTabs.Pages(i - 1).Name = "Page" & i
Me.DriverTabs.Pages(i - 1).Caption = rngTable.Item(i, 2).Value
End If
'Tab height
multiPage.TabFixedHeight = 25
lblName = "lr" & i & "Item" & j
lblBackground = "lblBkgrnd" & i & j
'Multipage page background
With multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
.BackColor = RGB(255, 255, 255)
.Width = multiPage.Width
.Height = multiPage.Height
.Top = 0
.Left = 0
End With
'For alternating the background in the item labels
Dim k As Integer
k = 1
'Loop through item table to add items to the multipage page
For j = 1 To itemTable.Rows.Count
If itemTable.Item(j, 2).Value = activeLeaderRoleId And itemTable.Item(j, 3) = JobGrade Then
Set itemLblBackground = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1", lblBackground)
Set itemLbl = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1", lblName)
altBgClr = RGB(250, 250, 250)
If (k Mod 2 = 0) Then altBgClr = RGB(255, 255, 255)
'Alternate background
With itemLblBackground
.Caption = ""
.BorderStyle = fmBorderStyleNone
.BackColor = altBgClr
.Left = 0
.Width = multiPage.Width
.Height = 35
.Top = itemTopPosition
End With
'display items
With itemLbl
.Caption = itemTable.Item(j, 4).Value
.BackStyle = fmBackStyleTransparent
.Font.Name = "Verdana"
.AutoSize = True
.Font.Size = 10
.Left = 6
.Width = itemLabelWidth
.Height = 30
.Top = (itemLblBackground.Top + (itemLblBackground.Height - itemLbl.Height) / 2) 'itemLblBackground.Top
End With
'==============================================================================================================
'
' LOW RADIO BUTTON
'
'==============================================================================================================
'Low radio button
Dim lowLabelName As String
Dim medLabelName As String
Dim highLabelName As String
Dim unknownLabelName As String
lowLabelName = "lowRadioGroup" & i & "_" & j
medLabelName = "medRadioGroup" & i & "_" & j
highLabelName = "highRadioGroup" & i & "_" & j
unknownLabelName = "unknownRadioGroup" & i & "_" & j
Set lowRadioButton = multiPage.Pages(i - 1).Controls.Add("Forms.OptionButton.1", lowLabelName)
With lowRadioButton
.Width = 20
.BackStyle = fmBackStyleTransparent
.Left = itemLabelWidth + 40
.Top = (itemLblBackground.Top + (itemLblBackground.Height - itemLbl.Height) / 2)
.GroupName = "RatingButton" & j
End With
RadioDictionary("Name") = lowLabelName
RadioDictionary("GroupName") = lowRadioButton.GroupName
RadioDictionary("Value") = lowRadioButton.Value
'==============================================================================================================
'
' MEDIUM RADIO BUTTON
'
'==============================================================================================================
Set medRadioButton = multiPage.Pages(i - 1).Controls.Add("Forms.OptionButton.1", medLabelName)
With medRadioButton
.Width = 20
.BackStyle = fmBackStyleTransparent
.Left = lowRadioButton.Left + lowRadioButton.Width + 40
.Top = (itemLblBackground.Top + (itemLblBackground.Height - itemLbl.Height) / 2)
.GroupName = "RatingButton" & j
End With
RadioDictionary("Name") = medLabelName
RadioDictionary("GroupName") = medRadioButton.GroupName
RadioDictionary("Value") = medRadioButton.Value
'==============================================================================================================
'
' HIGH RADIO BUTTON
'
'==============================================================================================================
Set highRadioButton = multiPage.Pages(i - 1).Controls.Add("Forms.OptionButton.1", highLabelName)
With highRadioButton
.Width = 20
.BackStyle = fmBackStyleTransparent
.Left = medRadioButton.Left + medRadioButton.Width + 40
.Top = (itemLblBackground.Top + (itemLblBackground.Height - itemLbl.Height) / 2)
.GroupName = "RatingButton" & j
End With
RadioDictionary("Name") = highLabelName
RadioDictionary("GroupName") = highRadioButton.GroupName
RadioDictionary("Value") = highRadioButton.Value
'==============================================================================================================
'
' DON'T KNOW RADIO BUTTON
'
'==============================================================================================================
Set unknownRadioButton = multiPage.Pages(i - 1).Controls.Add("Forms.OptionButton.1", unknownLabelName)
With unknownRadioButton
.Width = 22
.BackStyle = fmBackStyleTransparent
.Left = highRadioButton.Left + highRadioButton.Width + 45
.Top = (itemLblBackground.Top + (itemLblBackground.Height - itemLbl.Height) / 2)
.GroupName = "RatingButton" & j
End With
RadioDictionary("Name") = unknownLabelName
RadioDictionary("GroupName") = unknownRadioButton.GroupName
RadioDictionary("Value") = unknownRadioButton.Value
itemTopPosition = itemTopPosition + itemLblBackground.Height
k = k + 1
End If
Next j 'End item table range
'==============================================================================================================
'
' DISPLAY RATING OPTIONS AND LINE BOUNDARIES
'
'==============================================================================================================
'Adding a line in the headers
With multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
.Width = multiPage.Width - 10
.Height = 1
.Top = multiPage.TabFixedHeight + 16
.Left = multiPage.Left - 10
End With
'Adding a line between items and control
With multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
.Width = 1
.Height = multiPage.Height - multiPage.TabFixedHeight
.Top = 10
.Left = itemLabelWidth + 10
End With
'==============================================================================================================
'
' LOW
'
'==============================================================================================================
Set lowRatingLabelBg = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
'Low rating instruction background
With lowRatingLabelBg
.BackColor = RGB(244, 67, 54)
.Left = itemLabelWidth + 20
.Top = 12
.Width = 50
.Height = 25
End With
'Low rating instruction label
Set lowRatingLabel = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
With lowRatingLabel
.Caption = "LOW"
.BackColor = RGB(244, 67, 54)
.Width = 24
.Height = 12
.Left = lowRatingLabelBg.Left + (lowRatingLabelBg.Width - lowRatingLabel.Width) / 2
.Top = lowRatingLabelBg.Top + (lowRatingLabelBg.Height - lowRatingLabel.Height) / 2
.ForeColor = RGB(255, 255, 255)
End With
'Adding a line between items and control
With multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
.Width = 1
.Height = multiPage.Height - multiPage.TabFixedHeight
.Top = 10
.Left = lowRatingLabelBg.Width + lowRatingLabelBg.Left + 5
End With
'==============================================================================================================
'
' MEDIUM
'
'==============================================================================================================
Set medRatingLabelBg = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
'Med rating instruction
With medRatingLabelBg
.BackColor = RGB(255, 193, 7)
.Left = lowRatingLabelBg.Left + lowRatingLabelBg.Width + 10
.Top = 12
.Width = 50
.Height = 25
End With
'Low rating instruction label
Set medRatingLabel = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
With medRatingLabel
.Caption = "MEDIUM"
.BackStyle = fmBackStyleTransparent
.Width = 42
.Height = 12
.Left = medRatingLabelBg.Left + (medRatingLabelBg.Width - medRatingLabel.Width) / 2
.Top = medRatingLabelBg.Top + (medRatingLabelBg.Height - medRatingLabel.Height) / 2
.ForeColor = RGB(9, 9, 9)
End With
'Adding a line between items and control
With multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
.Width = 1
.Height = multiPage.Height - multiPage.TabFixedHeight
.Top = 10
.Left = medRatingLabelBg.Width + medRatingLabelBg.Left + 5
End With
'==============================================================================================================
'
' HIGH
'
'==============================================================================================================
Set highRatingLabelBg = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
'Med rating instruction
With highRatingLabelBg
.BackColor = RGB(46, 125, 50)
.Left = medRatingLabelBg.Left + medRatingLabelBg.Width + 10
.Top = 12
.Width = 50
.Height = 25
End With
Set highRatingLabel = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
With highRatingLabel
.Caption = "HIGH"
.BackStyle = fmBackStyleTransparent
.Width = 26
.Height = 12
.Left = highRatingLabelBg.Left + (highRatingLabelBg.Width - highRatingLabel.Width) / 2
.Top = highRatingLabelBg.Top + (highRatingLabelBg.Height - highRatingLabel.Height) / 2
.ForeColor = RGB(255, 255, 255)
End With
'Adding a line between items and control
With multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
.Width = 1
.Height = multiPage.Height - multiPage.TabFixedHeight
.Top = 10
.Left = highRatingLabelBg.Width + highRatingLabelBg.Left + 5
End With
'==============================================================================================================
'
' Don't Know
'
'==============================================================================================================
Set unknownRatingLabelBg = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
'Dont know rating instruction
With unknownRatingLabelBg
.BackColor = RGB(148, 176, 182)
.Left = highRatingLabelBg.Left + highRatingLabelBg.Width + 10
.Top = 12
.Width = 65
.Height = 25
End With
Set unknownRatingLabel = multiPage.Pages(i - 1).Controls.Add("Forms.Label.1")
With unknownRatingLabel
.Caption = "DON'T KNOW"
.BackStyle = fmBackStyleTransparent
.Width = 80
.Height = 12
.Left = unknownRatingLabelBg.Left + 9 + (unknownRatingLabelBg.Width - unknownRatingLabel.Width) / 2
.Top = unknownRatingLabelBg.Top + (unknownRatingLabelBg.Height - unknownRatingLabel.Height) / 2
.ForeColor = RGB(255, 255, 255)
End With
Next i 'End leader role table range
'Finally, get the actual page count
PageCount = multiPage.Pages.Count
End Sub
In regards of what I tried to suggest (in comments) I prepared a simple event wrapper class, which must be built in this way:
Insert a class module, name it optBClass and paste the next code inside it:
Option Explicit
Public WithEvents optEvent As MSForms.OptionButton
Private Sub optEvent_Change()
If optEvent.Name = "Opt1" Then
If optEvent.Value = True Then
testOptCreate.boolOpt1 = True
testOptCreate.boolOpt2 = False: testOptCreate.boolOpt3 = False
Else
testOptCreate.boolOpt1 = False
testOptCreate.boolOpt2 = False: testOptCreate.boolOpt3 = False
End If
ElseIf optEvent.Name = "Opt2" Then
If optEvent.Value = True Then
testOptCreate.boolOpt2 = True
testOptCreate.boolOpt1 = False: testOptCreate.boolOpt3 = False
Else
testOptCreate.boolOpt1 = False
testOptCreate.boolOpt2 = False: testOptCreate.boolOpt3 = False
End If
ElseIf optEvent.Name = "Opt3" Then
If optEvent.Value = True Then
testOptCreate.boolOpt3 = True
testOptCreate.boolOpt1 = False: testOptCreate.boolOpt2 = False
Else
testOptCreate.boolOpt1 = False
testOptCreate.boolOpt2 = False: testOptCreate.boolOpt3 = False
End If
End If
MsgBox optEvent.Name & " - " & optEvent.Value & vbCrLf & _
"boolOpt1 = " & testOptCreate.boolOpt1 & vbCrLf & _
"boolOpt2 = " & testOptCreate.boolOpt2 & vbCrLf & _
"boolOpt3 = " & testOptCreate.boolOpt3
End Sub
On top of the the form (module) you want to create option buttons, on the fly (testOptCreate in my exammple), please create the next variable (in the declarations part):
Option Explicit
Private optBColl As New Collection
Private OptionB() As New optBClass
Public boolOpt1 As Boolean, boolOpt2 As Boolean, boolOpt3 As Boolean
Create a button (btCreateOptB) and use this code for its Click event:
Private Sub btCreateOptB_Click()
Dim optCount As Long, theOptB As control, i As Long
optCount = 3
ReDim OptionB(0 To optCount)
For i = 1 To optCount
Set theOptB = Me.Controls.aDD("Forms.OptionButton.1", "Opt" & i, True)
With theOptB
.height = 17
.Caption = "Opt" & i
.left = 50 * i
End With
optBColl.aDD theOptB, theOptB.Name
Set OptionB(i).optEvent = theOptB
Next i
End Sub
Show the form and press btCreateOptB button!
Check each newly created option buttons. When first of them is clicked, the message box being shown display the clicked option button name, its value and the boolean variables associated to the group values.
Starting from the second option button click, the message will be shown twice. One time triggered by the previous option button change (its value becomes false) and second time referring to the last option button clicked.
Please, try understanding of its logic and try to apply it on your project.
If something not clear, do not hesitate to ask, even if I believe that it should be clear enough...
You can also use a Dictionary to automatically create boolean variables and use it to keep all of them and check when needed. Look, please at this test Sub:
Sub testDictionaryBooleanVar()
'it needs a reference to 'Microsoft Scripting Runtime`,
'or `dict` variable must be created `As Object` and create through `Set dict = CreateObject("scripting.dictionary")`
Dim it As Variant, dict As New Scripting.Dictionary, i As Long
With dict
For i = 1 To 10
.Item("boolOpt" & i) = False
Next i
End With
dict.Item("boolOpt2") = True: dict.Item("boolOpt5") = True
Debug.Print Join(dict.Items, "|")
Debug.Print dict("boolOpt2"), dict("boolOpt3")
End Sub
Presented this option in order to suggest a way to avoid manually creating boolean variables to be checked in the Option button Change event...
I want to create dynamic buttons and then implement the click method, but any help on the internet does not work here. I hope someone can help me here.
It is not possible to create all buttons. Unfortunately, there is no possibility to write in other languages because we can only use Excel and may.
This is about the infoBtn1_Click.
My Script
Option Explicit
Dim WithEvents infoBtn As MSForms.CommandButton
Dim WithEvents infoBtn1 As MSForms.CommandButton
Dim WithEvents frameCard As MSForms.frame
Dim WithEvents cardTitel As MSForms.Label
Dim WithEvents ausLabel As MSForms.Label
Dim WithEvents ausbilderLabel As MSForms.Label
Dim WithEvents amLabel As MSForms.Label
Dim WithEvents datumLabel As MSForms.Label
Dim WithEvents infoLabel As MSForms.Label
Dim add As Integer
Dim topPos As Integer
Dim ctl As Control
Dim n As Integer
Dim VorhabenArray() As Variant
Dim Free(1 To 5) As Long
Dim sh As Worksheet
Dim v As Range
Dim arr(0 To 40) As Integer
Dim i As Integer
Dim ausbildungNr As String
Dim speicher As String
Private Sub CommandButton1_Click()
If ComboBox1.Value = "" Then
MsgBox "Bitte tragen Sie eine Ausbildung ein."
Exit Sub
End If
ausbildungSuche.ausbildungCB.Value = ComboBox1.Value
Unload Me
Call ausbildungSuche.suchenBtn_Click
End Sub
Private Sub infoBtn1_Click()
MsgBox "test"
End Sub
Private Sub UserForm_Activate()
On Error GoTo fehler
ComboBox1.List = Sheets("Meta").Range("A1:A8").Value
speicher = ausbildungSuche.ausbildungCB.Value
Select Case speicher
Case "MilFit":
ausbildungNr = "1"
Case "Circuit training":
ausbildungNr = "2"
Case "Volleyball":
ausbildungNr = "3"
Case "Fußball":
ausbildungNr = "4"
Case "Sportliche Ertuechtigung":
ausbildungNr = "5"
Case "BFT":
ausbildungNr = "6"
Case "DSA":
ausbildungNr = "7"
Case "Schwimmen":
ausbildungNr = "8"
Case Else
MsgBox "Fehler"
End Select
Set sh = ThisWorkbook.Worksheets(ausbildungNr)
i = 0
topPos = 12
For Each v In sh.Range("M2:M100")
If Not v = "0" Then
Set frameCard = Controls.add("Forms.Frame.1", "frame" & i)
With frameCard
.Left = 144
.Top = topPos
.Width = 258
.Height = 72
.Caption = ""
.Zoom = 100
.SpecialEffect = 3
.BorderColor = &H80000012
End With
Set cardTitel = frameCard.Controls.add("Forms.Label.1", "cardTitel" & i, True)
With cardTitel
.Left = 8
.Top = 6
.Width = 126
.Height = 18
.ForeColor = &H8000000D
.Caption = v.Cells(, -10)
.FontBold = True
.FontSize = 12
End With
Set infoBtn = frameCard.Controls.add("Forms.CommandButton.1", "infoBtn" & i, True)
With infoBtn
.Left = 144
.Top = 36
.Width = 102
.Height = 24
.ForeColor = &HFFFFFF
.BackColor = &H8000000D
.Caption = v & " Plätze frei"
End With
Debug.Print "infoBtn" & i
Set ausLabel = frameCard.Controls.add("Forms.Label.1", "ausLabel", Visible)
With ausLabel
.Left = 12
.Top = 30
.Width = 42
.Height = 12
.Caption = "Ausbilder"
End With
Set ausbilderLabel = frameCard.Controls.add("Forms.Label.1", "ausbilderLabel", Visible)
With ausbilderLabel
.Left = 54
.Top = 30
.Width = 72
.Height = 12
.FontBold = True
.Caption = v.Cells(, -9)
End With
Set amLabel = frameCard.Controls.add("Forms.Label.1", "amLabel", Visible)
With amLabel
.Left = 12
.Top = 48
.Width = 24
.Height = 12
.Caption = "Am"
End With
Set datumLabel = frameCard.Controls.add("Forms.Label.1", "datumLabel", Visible)
With datumLabel
.Left = 54
.Top = 48
.Width = 72
.Height = 12
.FontBold = True
.Caption = v.Cells(, -8)
End With
Set infoLabel = frameCard.Controls.add("Forms.Label.1", "infoLabel", Visible)
With infoLabel
.Left = 222
.Top = 6
.Width = 24
.Height = 12
.FontBold = True
.Caption = "Info"
End With
topPos = frameCard.Top + frameCard.Height + 10
i = i + 1
End If
Next
ausbildungsfilter.Caption = ausbildungSuche.ausbildungCB.Value
Exit Sub
fehler: MsgBox "Das hat leider nicht geklappt."
Unload Me
End Sub
You need a class module beside the user form. Here is a sample of the mechanic how dynamic events works:
Place this code in the module of an empty user form:
Option Explicit
Dim comSampleBtn1 As clsClickEventsComBut
Dim comSampleBtn2 As clsClickEventsComBut
Private Sub UserForm_Initialize()
Dim comButTemp As MSForms.CommandButton
Dim commandButtonIndex As Byte
commandButtonIndex = 1
'Place sample button 1 and generate click event
Set comButTemp = Me.Controls.Add("Forms.commandbutton.1", "CommandButton" & commandButtonIndex, True)
commandButtonIndex = commandButtonIndex + 1
With comButTemp
'Place button
.Left = 50
.Top = 50
.Height = 20
.Width = 100
.Caption = "Sample Button 1"
.ControlTipText = "Click me"
End With
Set comSampleBtn1 = New clsClickEventsComBut
Set comSampleBtn1.ComButSample = comButTemp
Set comButTemp = Nothing
'Place sample button 2 and generate click event
Set comButTemp = Me.Controls.Add("Forms.commandbutton.1", "CommandButton" & commandButtonIndex, True)
commandButtonIndex = commandButtonIndex + 1
With comButTemp
'Place button
.Left = 50
.Top = 75
.Height = 20
.Width = 100
.Caption = "Sample Button 2"
.ControlTipText = "Click me too"
End With
Set comSampleBtn2 = New clsClickEventsComBut
Set comSampleBtn2.ComButSample = comButTemp
Set comButTemp = Nothing
End Sub
Now you need a class module with the name clsClickEventsComBut
Copy the following code to this module:
Option Explicit
Public WithEvents ComButSample As MSForms.CommandButton
Private Sub ComButSample_Click()
MsgBox "You clicked the sample button: " & UserForm1.ActiveControl.Name & Chr(13) & "With the caption: " & UserForm1.ActiveControl.Caption
End Sub
If you now click one of the two buttons, the message box will be show. This works with all controls.
Edit: New text for the message box with reference to the clicked button.
You have to assign this to the OnClick property of the button (usually on the OnLoad event or something similar):
infoBtn1.OnClick = "[Event Procedure]"
This assumes you have your Private Sub InfoBtn1_Click procedure declared like you have on your example code.
And note that it is this exact "[Event Procedure]" string that should be assigned to the OnClick.
I have a code here that will generate pages depends on what value is on the textbox.
'Button accepting how many number of pages
Private Sub CommandButton1_Click()
RowChar = 70
MultiPage1.Pages.Clear
For i = 0 To TextBox1.Value - 1
MultiPage1.Pages.Add
MultiPage1.Pages(i).Caption = "Variable" & i + 1
Call LabelPerPage
Set txtbx = UserForm1.MultiPage1.Pages(i).Controls.Add("Forms.TextBox.1", "NameBox")
With txtbx
.Top = 20
.Left = 100
End With
Set txtbx = UserForm1.MultiPage1.Pages(i).Controls.Add("Forms.TextBox.1", "MinBox")
With txtbx
.Top = 50
.Left = 100
End With
Set txtbx = UserForm1.MultiPage1.Pages(i).Controls.Add("Forms.TextBox.1", "LsbBox")
With txtbx
.Top = 20
.Left = 300
End With
Set txtbx = UserForm1.MultiPage1.Pages(i).Controls.Add("Forms.TextBox.1", "Mataas")
With txtbx
.Top = 50
.Left = 300
End With
If i = 0 Then
FormulaString = "= C15"
Else
FormulaString = FormulaString & " " & Chr(RowChar) & "15"
RowChar = RowChar + 3
End If
Next i
TextBox2.Value = FormulaString
End Sub
Problem: I want to disable commandbutton2(button for computation of MINbox and MAxbox) if all the textboxes inside each pages are empty. Do you have any IDEA how can I do that? Thank you.
Though best way and easiest way is to validate on click in CommandButton2_Click as answered by #Excelosaurus, i just offering slightly modified way of TextBox change event trapping by #Mathieu Guindon's answer in the post Implementing a change event to check for changes to textbox values and enabling the “apply” button. The full credit of this technique of encapsulating a WithEvents MSForms control goes to #Mathieu Guindon
in the Userform1 code module may be modified as below
Public handlers As VBA.Collection ' added
Private Sub CommandButton1_Click()
RowChar = 70
MultiPage1.Pages.Clear
For i = 0 To TextBox1.Value - 1
MultiPage1.Pages.Add
MultiPage1.Pages(i).Caption = "Variable" & i + 1
'Call LabelPerPage
Set txtbx = UserForm1.MultiPage1.Pages(i).Controls.Add("Forms.TextBox.1", "NameBox")
With txtbx
.Top = 20
.Left = 100
End With
Set txtbx = UserForm1.MultiPage1.Pages(i).Controls.Add("Forms.TextBox.1", "MinBox")
With txtbx
.Top = 50
.Left = 100
End With
Set txtbx = UserForm1.MultiPage1.Pages(i).Controls.Add("Forms.TextBox.1", "LsbBox")
With txtbx
.Top = 20
.Left = 300
End With
Set txtbx = UserForm1.MultiPage1.Pages(i).Controls.Add("Forms.TextBox.1", "Mataas")
With txtbx
.Top = 50
.Left = 300
End With
If i = 0 Then
FormulaString = "= C15"
Else
FormulaString = FormulaString & " " & Chr(RowChar) & "15"
RowChar = RowChar + 3
End If
Next i
TextBox2.Value = FormulaString
CommandButton2.Enabled = False ' added
makeEvents ' added
End Sub
Sub makeEvents() ' added
Set handlers = New VBA.Collection
Dim cnt As MSForms.Control
For i = 0 To UserForm1.MultiPage1.Pages.Count - 1
For Each cnt In UserForm1.MultiPage1.Pages(i).Controls
If TypeOf cnt Is MSForms.TextBox Then
Dim textBoxHandler As DynamicTextBox
Set textBoxHandler = New DynamicTextBox
textBoxHandler.Initialize cnt
handlers.Add textBoxHandler
'Debug.Print cnt.Name & i & "Inited"
End If
Next cnt
Next i
End Sub
Then Add a new class module to your project, call it DynamicTextBox
Option Explicit
Private WithEvents encapsulated As MSForms.TextBox
Public Sub Initialize(ByVal ctrl As MSForms.TextBox)
Set encapsulated = ctrl
End Sub
Private Sub encapsulated_Change()
Dim TextEmpty As Boolean
Dim cnt As Control
Dim i As Integer
For i = 0 To UserForm1.MultiPage1.Pages.Count - 1
For Each cnt In UserForm1.MultiPage1.Pages(i).Controls
If TypeOf cnt Is MSForms.TextBox Then
'Debug.Print cnt.Name & i & "checked"
If cnt.Value = "" Then
TextEmpty = True
Exit For
End If
End If
Next cnt
If TextEmpty = True Then
Exit For
End If
Next i
If TextEmpty Then
UserForm1.CommandButton2.Enabled = False
Else
UserForm1.CommandButton2.Enabled = True
End If
End Sub
Tried and found working
The easier way is to validate on click: in CommandButton2_Click, scan your dynamically created textboxes, and either proceed or notify the user about any validation error.
A more complicated way is to create a class that will monitor the events of a TextBox. You will create one instance of this class per TextBox you want to monitor, keeping those instances in e.g. an array. See How to add events to Controls created at runtime in Excel with VBA.
You can loop through each worksheet in your workbook, and for each worksheet - loop through all the OLEObjects. You will check the typename of the .Object, and perform your final tests there.
I would create a function that you can easily call to perform this check and return a Boolean True/False.
Function allTextboxEmpty() As Boolean
Dim oleObj As OLEObject, ws As Worksheet
allTextboxEmpty = True
For Each ws In ThisWorkbook.Worksheets
For Each oleObj In ws.OLEObjects
If TypeName(oleObj.Object) = "TextBox" Then
If oleObj.Object.Value <> vbNullString Then
allTextboxEmpty = False
Exit Function
End If
End If
Next oleObj
Next ws
End Function
If the above function returns True, then you know that all of your textboxes in the workbook are empty. You can use this function as shown in the below example:
If allTextboxEmpty Then
Worksheets("Sheet1").CommandButton2.Enabled = False
Else
Worksheets("Sheet1").CommandButton2.Enabled = True
End If
i've got dynamically generated userform consisting of labels, checkboxes and text boxes. is it possible to have a contents of a textbox selected when clicked?
this is method i'm using to create textbox:
Set NewTextBox = MainFrame.Controls.Add("Forms.TextBox.1")
With NewTextBox
.Name = "QtyTB" & row
.Value = Cells(cellrow - 1 + row, 11)
.Height = 18
.Left = 210
.Top = 18
.Width = 36
.Enabled = True
.BackColor = RGB(255, 255, 0)
End With
if i was to create textbox manually i could write on_click sub for specific text box. but as i said, code generates everything from scratch.
so if there is a property, or some other way to get it done, i would be gratefull.
Yes, this can be done by creating a class module with event handling
The following code will need a bit of adaption as there isn't much code to go on in the question...
In a class module called TextBoxEventHandler
Private WithEvents FormTextBox As MSForms.TextBox
Public Property Set TextBox(ByVal oTextBox As MSForms.TextBox)
Set FormTextBox = oTextBox
End Property
Private Sub FormTextBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
With FormTextBox
.SelStart = 0
.SelLength = Len(.Text)
End With
End If
End Sub
Then in the UserForm code
Private CollectionOfEventHandlers As Collection
Private Sub UserForm_Initialize()
Dim i As Long
Dim NewTextBox As MSForms.TextBox
For i = 0 To 4
Set NewTextBox = Me.Controls.Add("Forms.TextBox.1")
With NewTextBox
.Name = "QtyTB" & i ' Row
.Value = "Text " & i ' Cells(cellrow - 1 + Row, 11)
.Height = 18
.Left = 21
.Top = 18 + i * 25
.Width = 36
.Enabled = True
.BackColor = RGB(255, 255, 0)
End With
Next i
Call InitialiseHandlers
End Sub
Private Function InitialiseHandlers()
Set CollectionOfEventHandlers = New Collection
Dim FormControl As Control
For Each FormControl In Me.Controls
If TypeName(FormControl) = "TextBox" Then
Dim EventHandler As TextboxEventHandler
Set EventHandler = New TextboxEventHandler
Set EventHandler.TextBox = FormControl
CollectionOfEventHandlers.Add EventHandler
End If
Next FormControl
End Function