I wrote sub which add checkbox like below
Sub WstawCHB(i As Integer, ByVal ws As Worksheet)
Dim NewCheckBox As MSForms.CheckBox
Set NewCheckBox = ListaObecnosciForm.Controls.Add("Forms.Checkbox.1", "CB" & i, True)
With NewCheckBox
.Top = 20 * i
.Left = 20
.Width = 450
.Height = 24
.Caption = ws.Cells(2 + i, 27)
.Value = False
End With
End Sub
How to add some action to the checkbox in code. For example (.OnAction = "CheckBox1_Click")
Private Sub CheckBox1_Click()
MsgBox "Hello World!"
End Sub
Additional information: the Sub is calling in loop in code below, so I have to "inject" code for every created checkbox for each iteration of loop
Sub DodajCHB(ByVal LW As Integer, ByVal ws As Worksheet)
Dim i As Integer
i = 1
Do While i < LW
Call WstawCHB(i, ws)
i = i + 1
Loop
End Sub
Related
T he code below is what I am having some problems with. I'm pretty green to using Userforms in VB.
My goal is to create 3 ComboBoxes drawing data from the column of Vendors in the sheet "Vendor Bids" and 3 ListBoxes to select the vendor's product.
For j = 1 To 3
Set myCombo = Frame1.Controls.Add("Forms.ComboBox.1", "ComboBox" & j)
Set myList = Frame1.Controls.Add("Forms.ListBox.1", "ListBox" & j)
With myList
.Top = 18 + (150 - 84) * (j - 1)
.Height = 34.85
.Left = 198
.Width = 180
MsgBox .Name
End With
With myCombo
.Top = 18 + (150 - 84) * (j - 1)
.Height = 22.8
.Left = 42
.Width = 132
End With
Set rData = ThisWorkbook.Worksheets("VendorBids").Range("A:A").CurrentRegion
Me.Controls("ComboBox" & j).List = rData.Offset(1).Value
Me.Controls("ListBox" & j).ColumnCount = 1
Me.Controls("ListBox" & j).List = rData.Offset(1, 1).Value
Next
This part works perfectly. The reason I have this coded and not made in the Userform is because I have a function to add another row of the Combo and List boxes when the user presses the commandbutton. It works perfectly as well.
The problem I am having is with ComboBox_Change(). If I create the combobox in the UserForm GUI editor then ComboBox1_Change() will work. Below is an example with what I'm trying to achieve but with all of the generated comboboxes, like ComboBox2, 3, and so on...
Private Sub ComboBox1_Change()
Me.ListBox1.ListIndex = Me.ComboBox1.ListIndex
End Sub
I apologize if I'm not very clear in my logic or explanations - this is something I'm working to improve on as a novice.
Reference:Chip Pearson - Events And Event Procedures In VBA
You will need a combination of WithEvents and RaiseEvents to handle the events of the new controls.
ComboBoxHandler:Class
Stores a reference to a single Combobox. Using WithEvents it notifies the ControlHandlerCollection when the ComboBox_Change().
Option Explicit
Public ControlHandlerCollection As VBAProject.ControlHandlerCollection
Public WithEvents ComboBox As MSForms.ComboBox
Private Sub ComboBox_Change()
ControlHandlerCollection.ComboBoxChanged ComboBox
End Sub
ListBoxHandler:Class
Stores a reference to a single ListBox . Using WithEvents it notifies the ControlHandlerCollection when the ListBox_Change().
Option Explicit
Public ControlHandlerCollection As VBAProject.ControlHandlerCollection
Public WithEvents ListBox As MSForms.ListBox
Private Sub ListBox_Change()
ControlHandlerCollection.ListBoxChanged ListBox
End Sub
ControlHandlerCollection:Class
Holds a collection of both ComboBoxHandlers and ListBoxHandlers whenever one of the handler class notifies it of a change it raises an event to notify the Userform of the change.
Private EventHandlers As New Collection
Public Event ComboBoxChange(ComboBox As MSForms.ComboBox)
Public Event ListBoxChange(ListBox As MSForms.ListBox)
Public Sub AddComboBox(ComboBox As MSForms.ComboBox)
Dim ComboBoxHandler As New ComboBoxHandler
Set ComboBoxHandler.ControlHandlerCollection = Me
Set ComboBoxHandler.ComboBox = ComboBox
EventHandlers.Add ComboBoxHandler
End Sub
Public Sub AddListBox(ListBox As MSForms.ListBox)
Dim ListBoxHandler As New ListBoxHandler
Set ListBoxHandler.ControlHandlerCollection = Me
Set ListBoxHandler.ListBox = ListBox
EventHandlers.Add ListBoxHandler
End Sub
Public Sub ComboBoxChanged(ComboBox As MSForms.ComboBox)
RaiseEvent ComboBoxChange(ComboBox)
End Sub
Public Sub ListBoxChanged(ListBox As MSForms.ListBox)
RaiseEvent ListBoxChange(ListBox)
End Sub
UserForm1:UserForm
Option Explicit
Private WithEvents ControlHandlerCollection As ControlHandlerCollection
Private Sub ControlHandlerCollection_ComboBoxChange(ComboBox As MSForms.ComboBox)
MsgBox "Value: " & ComboBox.Value & vbNewLine & _
"Name: " & ComboBox.Name & vbNewLine & _
"Tag: " & ComboBox.Tag
End Sub
Private Sub ControlHandlerCollection_ListBoxChange(ListBox As MSForms.ListBox)
MsgBox "Value: " & ListBox.Value & vbNewLine & _
"Name: " & ListBox.Name & vbNewLine & _
"Tag: " & ListBox.Tag
End Sub
Private Sub UserForm_Initialize()
Set ControlHandlerCollection = New ControlHandlerCollection
End Sub
Private Sub btnAddRow_Click()
Dim j As Long
Dim rData As Range
Dim myCombo As MSForms.ComboBox, myList As MSForms.ListBox
Set rData = ThisWorkbook.Worksheets("VendorBids").Range("A:A").CurrentRegion
For j = 1 To 3
Set myCombo = Frame1.Controls.Add("Forms.ComboBox.1", "ComboBox" & j)
Set myList = Frame1.Controls.Add("Forms.ListBox.1", "ListBox" & j)
With myList
.Top = 18 + (150 - 84) * (j - 1)
.Height = 34.85
.Left = 198
.Width = 180
.ColumnCount = 1
.List = rData.Offset(1, 1).Value
.Tag = rData.Offset(1, 1).Address
End With
With myCombo
.Top = 18 + (150 - 84) * (j - 1)
.Height = 22.8
.Left = 42
.Width = 132
.List = rData.Offset(1).Value
.Tag = rData.Offset(1).Address
End With
ControlHandlerCollection.AddComboBox myCombo
ControlHandlerCollection.AddListBox myList
Next
End Sub
I'm a beginner with VBA, I'm developing a macro on excel 2007 and I'm having some problems with the ComboBox. Anywhere I try to add items i always get the error 70 "Permission Denied". What is my mistake?
Below you can find my simple code
Private Sub CommandButton2_Click()
Dim pic As IPictureDisp
Set pic = UserForm1.Image1.Picture
'stdole.SavePicture pic, "ciao"
Call SavePicture(pic, "ciao.jpg")
End Sub
Private Sub CommandButton3_Click()
Dim MyChart As Chart
Dim ChartData As Range
Dim ChartName As String
ChartName = "ANCONA"
Set ChartData = ActiveSheet.Range("A1:A9")
Application.ScreenUpdating = True
'UserForm1.Image4.Picture = LoadPicture("C:\Users\rfori\Desktop\PROGETTO
MARTINA\parto_trig.jpg")
'
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
With MyChart.SeriesCollection.NewSeries
.Name = ChartName
.Values = ChartData
.XValues = ActiveSheet.Range("B1:B9")
End With
Dim imageName As String
imageName = "prova.jpg"
MyChart.Export Filename:=imageName, FilterName:="jpg"
Application.ScreenUpdating = True
UserForm1.Image1.Picture = LoadPicture("prova.jpg")
'MyChart.SeriesCollection(1).Name = ChartName
'MyChart.SetSourceData Source:=ChartData
End Sub
Private Sub UserForm_Activate()
ComboBox1.AddItem "ciao"
End Sub
Private Sub UserForm_Initialize()
ComboBox1.AddItem "ciao"
With Me
.StartUpPosition = 1
.Width = MultiPage1.Width
.Height = MultiPage1.Height
.Left = Application.Left - (Application.Width * 0.85) \ 2
.Top = Application.Top - (Application.Height * 0.85) \ 2
End With
myarray1 = Array("Ancona", "Milano", "Palermo")
For x = 0 To 2
'ComboBox1.AddItem myarray1(x)
Next x
End Sub
Sub window_sizer()
With ActiveWindow
.WindowState = xlNormal`enter code here`
.Height = 75
.Width = 125
.ScrollColumn = 1
.ScrollRow = 1
End Sub
Thank you in advance
had the same problem before as described in Combobox additem permission denied error no.70
.
Make sure that the property ListFillRange is empty.
I dynamically defined checkboxes, which are added to the userform on runtime.
Sub Userform_Initialize()
For i = 1 To 4
Set Chk = Frame4.Controls.Add("Forms.Checkbox.1", "Checkbox" & i)
With Chk
.top = 84 + k
.left = 336
.Width = 100
.Height = 18
.Caption = "Add item"
.Visible = True
End With
k = k + 24
Next i
End Sub
Public WithEvents Chk As MSForms.CheckBox
Private Sub Chk_Click()
MsgBox Chk
End Sub
For some reason, the event doesn't respond. Does anyone have an idea as to why? I need the boolean of the checkbox. That means when the user clicked on a dynamic checkbox, then I see "True" returned in the msgbox.
Add a class module to your project, name it as you want (say "ChkBox"), and put this code in it:
Public WithEvents Chk As MSForms.CheckBox
Private Sub Chk_Click()
MsgBox Chk.Value
End Sub
In your userform code, add this
Dim myChks(1 To 4) As New ChkBox '<--| this must be at the very top of your userform code pane
Sub Userform_Initialize()
Dim i As Long, k As Long
With Me.Frame4.Controls
For i = 1 To 4
With .Add("Forms.Checkbox.1", "Checkbox" & i)
.Top = 84 + k
.Left = 336
.Width = 100
.Height = 18
.Caption = "Add item"
.Visible = True
Set myChks(i).Chk = .Parent.Item(.Name)
End With
k = k + 24
Next i
End With
End Sub
I have tried #DaveShaw code, for events on runtime for checkboxes, is click not an valid method for checkbox? It never get into the method checkBoxEvent_click
Dim CheckBoxArray() As New ClassEvents
for i=0 to 10
Set cTemp = MOM.Frame_MOM_MOM.Controls.Add("Forms.CheckBox.1")
With cTemp
.Top = HeaderOffset + RowOffset + i * 25 'your top pos
.Visible = True
.Left = 30 'your left pos
.Width = widthOfLabel 'your width
.Name = Replace(keyArrays(i, 1), " ", "_")
.Caption = keyArrays(i, 1) 'your caption ,
End With
ReDim Preserve CheckBoxArray(0 To i)
Set CheckBoxArray(i).checkBoxEvent = cTemp
next i
and my ClassEvents class looks like this:
Public WithEvents checkBoxEvent As MSForms.checkBox
Private Sub checkBoxEvent_click()
MsgBox "halla" 'checkBox.Caption
End Sub
you have to keep Dim CheckBoxArray() As New ClassEvents at the very top of your userfom code pane, thus outside any of its subs/functions
furthermore use Option Explicit statement too
it becomes
Option Explicit
Dim CheckBoxArray() As New ClassEvents '<--| keep this line at the very top of your userform code pane
Private Sub UserForm_Initialize()
Dim i As Long
Dim cTemp As MSForms.CheckBox '<-- with "Option Explicit" you have to declare all your variables
For i = 0 To 10
Set cTemp = MOM.Frame_MOM_MOM.Controls.Add("Forms.CheckBox.1")
With cTemp
.Top = HeaderOffset + RowOffset + i * 25 'your top pos
.Visible = True
.Left = 30 'your left pos
.Width = widthOfLabel 'your width
.Name = Replace(keyArrays(i, 1), " ", "_")
.Caption = keyArrays(i, 1) 'your caption ,
End With
ReDim Preserve CheckBoxArray(0 To i)
Set CheckBoxArray(i).checkBoxEvent = cTemp
Next i
End Sub
furthermore, since you already know the dimension of your array, Dim it at the beginning and don't ReDim it at every iteration:
Option Explicit
Dim CheckBoxArray(0 To 10) As New ClassEvents '<--| keep this line at the very top of your userform code pane
Private Sub UserForm_Initialize()
Dim i As Long
Dim cTemp As MSForms.CheckBox '<-- with "Option Explicit" you have to declare all your variables
For i = 0 To 10
Set cTemp = MOM.Frame_MOM_MOM.Controls.Add("Forms.CheckBox.1")
With cTemp
.Top = HeaderOffset + RowOffset + i * 25 'your top pos
.Visible = True
.Left = 30 'your left pos
.Width = widthOfLabel 'your width
.Name = Replace(keyArrays(i, 1), " ", "_")
.Caption = keyArrays(i, 1) 'your caption ,
End With
Set CheckBoxArray(i).checkBoxEvent = cTemp
Next i
End Sub
I have a userform that creates two dynamic control buttons but I am having difficulty accessing the .name property of the dynamic control, which means I can't create the event handler correctly. Due to this problem I am unable to create event handlers. Below shows the code that creates the dynamic controls and also the code that I have written for the event handlers (which isn't functioning correctly)
Option Explicit
Public WithEvents cButton As MSForms.CommandButton
Private Sub TextBox1_Change()
If TextBox1 <> vbNullString Then
For i = 1 To TextBox1.Value
Set cButton = Me.Controls.Add("Forms.CommandButton.1")
With cButton
.Name = "CommandButton" & i
.Left = 150
.Top = buttonStartPosition
.Width = 300
.Height = 140
End With
Next i
End If
End sub
Private Sub cButton_Click()
If cButton.Name = "CommandButton1" Then
MsgBox "Button1"
ElseIf cButton.Name = "CommandButton2" Then
MsgBox "Button2"
End If
End Sub
Once this code is executed and the two buttons are on the screen, I press the first button (button1) and nothing happens but when I press the second button (button2) I receive the message "Button2". So how come I can't access the first button?
#user3538102 .. To your comment regarding Textbox's. Below is example is an example. I added Combo box select either CommandButton or TextBox and generate events. The code works but could be better.
I added combo box to select to dynamically generate object type.
In UserForm Activate event - Add combo drop down list
Private Sub UserForm_Activate()
ComboBox1.AddItem "CommandButton"
ComboBox1.AddItem "TextBox"
ComboBox1.ListIndex = 0
End Sub
In Class1 Class Module ..
Modified UserForm code ..
Option Explicit
Dim cObjs() As New Class1
Private Sub TextBox1_Change()
Dim i As Integer
Dim buttonStartPosition As Integer
Dim cObj As Object
buttonStartPosition = 30
If TextBox1 <> vbNullString Then
For i = 1 To TextBox1.Value
If ComboBox1.Value = "CommandButton" Then
Set cObj = Me.Controls.Add("Forms.CommandButton.1")
Else
Set cObj = Me.Controls.Add("Forms.TextBox.1")
End If
With cObj
.Name = ComboBox1.Value & i
.Left = 15
.Top = buttonStartPosition
.Width = 30
.Height = 14
End With
ReDim Preserve cObjs(1 To i)
If ComboBox1.Value = "CommandButton" Then
Set cObjs(i).ButtonGroup = cObj
Else
Set cObjs(i).TextGroup = cObj
End If
buttonStartPosition = buttonStartPosition + 14
Next i
End If
End Sub
I got the events for multiple buttons to work with help from .. JWalk Excel Tips
Below is the modification based on your code and the link provided.
Create a Class module called "Class1"
Add modified code to UserForm1..
Option Explicit
Dim Buttons() As New Class1
Private Sub TextBox1_Change()
Dim i As Integer
Dim buttonStartPosition As Integer
Dim cButton As CommandButton
buttonStartPosition = 30
If TextBox1 <> vbNullString Then
For i = 1 To TextBox1.Value
Set cButton = Me.Controls.Add("Forms.CommandButton.1")
With cButton
.Name = "CommandButton" & i
.Left = 15
.Top = buttonStartPosition
.Width = 30
.Height = 14
End With
ReDim Preserve Buttons(1 To i)
Set Buttons(i).ButtonGroup = cButton
buttonStartPosition = buttonStartPosition + 14
Next i
End If
End Sub