So i have been at this for a while now and I have searched through many websites and forums but alas I can not find a solution to my issue.
I am trying to add arguments to an .OnAction event for a Checkbox
So.. For example
Dim chk as Checkbox
With chk
.name = "chk" & .TopLeftCell.Offset(0, -7).Text
.Caption = ""
.Left = cel.Left + (cel.Width / 2 - chk.Width / 2) + 7
.Top = cel.Top + (cel.Height / 2 - chk.Height / 2)
.OnAction = "CheckboxHandle(chk)"
End With
So if I was trying to call this sub -> Public Sub CheckboxHandle(obj As CheckBox)
It requries a CheckBox Object to be able to run (this can change to a shape/Object if necessary)
THINGS I HAVE TRIED
Changing the data type to object and shape however i couldn't find a way to pass it through
Variations of the below statements
"""CheckboxHandle(chk)"""
"'CheckboxHandle" ""chk"" '"
Application.caller then looping through objects to find the object whit that name (this takes way too long as I have over 300 Checkboxes)
CONTEXT
In case the context helps I am trying to add a checkbox to every cell in a range and then have each one call the same method when they are clicked. I need the OnAction to send an Object as i look for the TopleftCell of the Object to change the colour of the adjacent cells
IN CASE IT IS HELPFUL
here is the method i would like to call from the OnAction Event
Public Sub CheckboxHandle(obj As CheckBox)
Dim rng As Range
'Sneaky sneaky changes
Application.ScreenUpdating = False
'For Loop to go through each of the cells to the left of the check box
For Each rng In Range(obj.TopLeftCell, obj.TopLeftCell.Offset(0, -7))
With rng
'if the checkbox is checked
If obj.Value = -1 Then
.Interior.Color = RGB(202, 226, 188)
'Adds the date and the person so you know who did the edit
obj.TopLeftCell.Offset(0, 1).Value = Now & " by " & Application.username
Else
'if it isn't checked
.Interior.Pattern = xlNone
'removes the edit name and date
obj.TopLeftCell.Offset(0, 1).Value = ""
End If
End With
Next rng
'Shows all the changes at the same time
Application.ScreenUpdating = True
'Changes the value of the progress bar to represent the project completion
If obj.Value = -1 Then
ActiveSheet.Range("E1").Value = ActiveSheet.Range("E1").Value + 1 / 207
Else
ActiveSheet.Range("E1").Value = ActiveSheet.Range("E1").Value - 1 / 207
End If
End Sub
Any help on this issue would be much appreciated
-Sebic0
I don't think that you can pass an object via the OnAction. The OnAction-property is a string holding the name of a Sub (plus parameter).
You could try to pass the name of the checkBox instead. Note that you have to enclose the name of the checkbox in double quotes, so that you would get something like. CheckboxHandle "chk123":
.OnAction = "'CheckboxHandle """ & .Name & """'"
And change your Action-routine
Public Sub CheckboxHandle(chbBoxName as string)
dim chk as CheckBox
Set chk = ActiveSheet.CheckBoxes(chkBoxName)
(...)
Related
Im working with a workbook with many sheets and im using a UserForm with more than 150 Combobox and arround 200 Labels.
I want to set the charasteristic and design of the comboboxes in only one and i want to be applied in a lot of them, so i do not want to repeat the code hundreds of times.
How should i do? i ve been reading but i cant match the examples with mine.
This is the wrong code:
Private Sub ComboBox7_Change()
Dim ws2 As Worksheet: Set ws2 = Sheets("C. VfM Questionnaire ")
Dim i, p As Integer
For i = 7 To 31
If Controls("ComboBox" & i).Value = "Yes" Then
ws2.Range("G7") = 4
Me.Controls("Label" & i).BackColor = RGB(146, 208, 80)
ElseIf Controls("ComboBox" & i).Value = "No" Then
ws2.Range("G7") = 4
Me.Controls("Label" & i).BackColor = RGB(255, 33, 26)
ElseIf Controls("ComboBox" & i).Value = "Not Applicable" Then
ws2.Range("G7") = 4
Me.Controls("Label" & i).BackColor = RGB(255, 204, 0)
End If
Next i
End Sub
Also i do not know how to trigger the code? is it in te user form initalize or in a module? Im so newbee as you can see!
Thanks a lot in advance.
If I understood your question correctly, you have a lot of ComboBoxes, and you want to change their style. But instead of changing all of them, you want to change one of them, and then have the form apply this style to all of them, right?
So we pick a box to be the "style guide" and assign that to a variable.
Then we loop though all the ComboBoxes in the Form, and apply the traits.
As for how to trigger it, UserForm initalize would certainly work.
This code for example:
Private Sub UserForm_Initialize()
Dim origin As ComboBox, c As Variant
Set origin = Me.ComboBox1 'Combobox to copy style from
For Each c In Me.Controls
If TypeName(c) = "ComboBox" Then
c.BackColor = origin.BackColor
c.BackStyle = origin.BackStyle
c.BorderColor = origin.BorderColor
c.BorderStyle = origin.BorderStyle
c.ForeColor = origin.ForeColor
End If
Next
End Sub
Changes this:
To this:
Applying the style of the first box, in the top left corner, called ComboBox1
I've got a question concerning combobox in Excel.
I've got an excel sheet that by default contains two comboboxes and their number is described by a variable x (x=2 by default). Each combobox is scripted to behave in a particular way in subs, for example I've got: private sub ComboBox1_DropButtonClick().
Nonetheless, sometimes I need to increase the number of these boxes by changing the value of X. I may need up to 10 comboboxes in total. Now the question is whether there's any way in which I can set the behaviour of an infinite number of comboboxes (for example in the event of DropButtonClick). What I did was to write a code for each of those comboboxes, so I've got a sub for ComboBox1_DropButtonClick(), ComboBox2_DropButtonClick(), ComboBox3_DropButtonClick(), etc.. The code varies a bit, but it's repeatable. So it all looks rather dumb and I'm searching for some more ingenious solution. Maybe all those comboboxes can be scripted in one go? If there's any way to do it, please share it with me.
Thanks, Wojciech.
[edit] Location of my code (marked in grey):
Screenshot from VBA editor in VBA
Here is some code to dynamically add controls to an Excel Userform, and add the code behind. The code added will make it display a MessageBox when the ComboBox receives a KeyDown.
The code is somewhat commented, but let me know if you have questions :)
Option Explicit
Sub CreateFormComboBoxes(NumberOfComboBoxes As Long)
Dim frm As Object
Dim ComboBox As Object
Dim Code As String
Dim i As Long
'Make a blank form called 'UserForm1', or any name you want
'make sure it has no controls or any code in it
Set frm = ThisWorkbook.VBProject.VBComponents("UserForm1")
With frm
For i = 1 To NumberOfComboBoxes
Set ComboBox = .designer.Controls.Add("Forms.ComboBox.1")
'Set the properties of the new controls
With ComboBox
.Width = 100
.Height = 20
.Top = 20 + ((i - 1) * 40) 'Move the control down
.Left = 20
.Visible = True
.ZOrder (1)
.Name = "ComboBox" & i
End With
'Add your code for each module, you can add different code, by adding a if statement here
'And write the code depending on the name, index, or something else
Code = Code & vbNewLine & "Private Sub " & "ComboBox" & i & "_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)" & _
vbNewLine & " MsgBox(""hi"")" & vbNewLine & "End Sub"
Next
'Add the code
.CodeModule.InsertLines 2, Code
End With
End Sub
'Run this
Sub Example()
CreateFormComboBoxes 5
End Sub
**Edit**
I figured I might as well add the other approach for adding controls dynamically to an Excel sheet. I'd recommend sticking to UserForms, but, here's a method that should help out when controls are needed in a Sheet.
Sub addCombosToExcelSheet(MySheet As Worksheet, NumberOfComboBoxes As Long, StringRangeForDropDown As String)
Dim i As Long
Dim combo As Shape
Dim yPosition As Long
Dim Module As Object
yPosition = 20
For i = 1 To NumberOfComboBoxes
yPosition = (i - 1) * 50
'Create the shape
Set combo = MySheet.Shapes.AddFormControl(xlDropDown, 20, yPosition, 100, 20)
' Range where the values are stored for the dropDown
combo.ControlFormat.ListFillRange = StringRangeForDropDown
combo.Name = "Combo" & i
Code = "Sub Combo" & i & "_Change()" & vbNewLine & _
" MsgBox(""hi"")" & vbNewLine & _
"End Sub"
'Add the code
With ThisWorkbook
'Make sure Module2 Exits and there is no other code present in it
Set Module = .VBProject.VBComponents("Module2").CodeModule
Module.AddFromString (Code)
End With
'Associate the control with the action, don't include the () at the end!
combo.OnAction = "'" & ActiveWorkbook.Name & "'!Combo" & i & "_Change"
Next
End Sub
Sub Example()
Dim sht As Worksheet: Set sht = ThisWorkbook.Sheets(1)
addCombosToExcelSheet sht, 10, "Sheet1!$A$1:$A$10"
End Sub
Program: Excel 2016.
I have a sheet with a lot of shapes. Each of them has its own specific name and most of them are label. I want to change their caption property, but i can't find a way but calling them one by one like this:
LblLabel_1.Caption = ...
LblLabel_2.Caption = ...
LblLabel_3.Caption = ...
Instead i was looking for something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01).Caption = ...
Next
This one will result in error 438, basically saying Caption is not avaiable for this object. It still target the object, since this code:
Debug.print Shapes("LblLabel_" & BytCounter01).Name
will return me its name.
Looking for a solution:
-i've tried Controls("LblLabel_" & BytCounter01) instead of Shapes("LblLabel_" & BytCounter01) but it won't work since Controls is only for userforms, not for sheets;
-i've tried Shapes("LblLabel_" & BytCounter01).TextFrame.Characters.Text but it returns error 438 again;
-since the label is a part of a group, i've tried both
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).Caption
and
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).TextFrame.Characters.Text
but got 438 again.
Is there really no way to easily target a specific label on a sheet and change his caption?
Thank you.
EDIT: thanks to Excelosaurus, the problem is solved. Since my labels are ActiveX Controls i have to use something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01)OLEFormat.Object.Object.Caption = ...
Next
You can check his response and comments for more details. Thanks again Excelosaurus!
To change the textual content of a shape, use .TextFrame2.TextRange.Text as shown below:
shtShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
where shtShapes is the name of your worksheet's object as seen from the Visual Basic Editor in the Project Explorer,
sShapeName is a string variable containing the name of the target shape, and
sShapeCaptionis a string variable containing the desired caption.
A code example follows. I've thrown in a function to check for a shape's existence on a worksheet, by name.
Option Explicit
Public Sub SetLabelCaptions()
Dim bCounter As Byte
Dim sShapeName As String
Dim sShapeCaption As String
For bCounter = 1 To 255
sShapeName = "LblLabel_" & CStr(bCounter)
If ShapeExists(shtMyShapes, sShapeName) Then
sShapeCaption = "Hello World " & CStr(bCounter)
shtMyShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
Else
Exit For
End If
Next
End Sub
Public Function ShapeExists(ByVal pshtHost As Excel.Worksheet, ByVal psShapeName As String) As Boolean
Dim boolResult As Boolean
Dim shpTest As Excel.Shape
On Error Resume Next
Set shpTest = pshtHost.Shapes(psShapeName)
boolResult = (Not shpTest Is Nothing)
Set shpTest = Nothing
ShapeExists = boolResult
End Function
The result should look like this:
You can't assign a Caption to a Shape. (Shapes don't have Captions). One approach is to loop over the Shapes and build a little table to tell you what to loop over next:
Sub WhatDoIHave()
Dim kolumn As String, s As Shape
Dim i As Long, r As Range
kolumn = "Z"
i = 1
For Each s In ActiveSheet.Shapes
Set r = Cells(i, kolumn)
r.Value = i
r.Offset(, 1).Value = s.Name
r.Offset(, 2).Value = s.Type
r.Offset(, 3).Value = s.TopLeftCell.Address(0, 0)
i = i + 1
Next s
End Sub
Which for my sample produced:
Seeing that I have both Forms and ActiveX (OLE) Controls, I know what to loop over next. I then refer to the Control by number and assign a Caption if appropriate.
I'm having a problem assigning VBA generated ActiveX checkboxes to a class module. When a user clicks a button, the goal of what I am trying to achieve is: 1st - delete all the checkboxes on the excel sheet; 2nd - auto generate a bunch of checkboxes; 3rd - assign a class module to these new checkboxes so when the user subsequently clicks one of them, the class module runs.
I've borrowed heavily from previous posts Make vba code work for all boxes
The problem I've having is that the 3rd routine (to assign a class module to the new checkboxes) doesn't work when run subsequently to the first 2 routines. It runs fine if run standalone after the checkboxes have been created. From the best I can tell, it appears VBA isn't "releasing" the checkboxes after they have been created to allow the class module to be assigned.
The below code is the simplified code that demonstrates this problem. In this code, I use a button on "Sheet1" to run Sub RunMyCheckBoxes(). When button 1 is clicked, the class module did not get assigned to the newly generated checkboxes. I use button 2 on "Sheet1" to run Sub RunAfter(). If button 2 is clicked after button 1 has been clicked, the checkboxes will be assigned to the class module. I can't figure out why the class module won't be assigned if just the first button is clicked. Help please.
Module1:
Public mcolEvents As Collection
Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Call SetCBAction("Sheet1")
End Sub
Sub DeleteAllCheckboxesOnSheet(SheetName As String)
Dim obj As OLEObject
For Each obj In Sheets(SheetName).OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
obj.Delete
End If
Next
End Sub
Sub InsertCheckBoxes(SheetName As String, CellRow As Double, CellColumn As Double, CBName As String)
Dim CellLeft As Double
Dim CellWidth As Double
Dim CellTop As Double
Dim CellHeight As Double
Dim CellHCenter As Double
Dim CellVCenter As Double
CellLeft = Sheets(SheetName).Cells(CellRow, CellColumn).Left
CellWidth = Sheets(SheetName).Cells(CellRow, CellColumn).Width
CellTop = Sheets(SheetName).Cells(CellRow, CellColumn).Top
CellHeight = Sheets(SheetName).Cells(CellRow, CellColumn).Height
CellHCenter = CellLeft + CellWidth / 2
CellVCenter = CellTop + CellHeight / 2
With Sheets(SheetName).OLEObjects.Add(classtype:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, Left:=CellHCenter - 8, Top:=CellVCenter - 8, Width:=16, Height:=16)
.Name = CBName
.Object.Caption = ""
.Object.BackStyle = 0
.ShapeRange.Fill.Transparency = 1#
End With
End Sub
Sub SetCBAction(SheetName)
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets(SheetName).OLEObjects
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckBoxes = o.Object
mcolEvents.Add cCBEvents
End If
Next
End Sub
Sub RunAfter()
Call SetCBAction("Sheet1")
End Sub
Class Module (clsActiveXEvents):
Option Explicit
Public WithEvents mCheckBoxes As MSForms.CheckBox
Private Sub mCheckBoxes_click()
MsgBox "test"
End Sub
UPDATE:
On further research, there is a solution posted in the bottom answer here:
Creating events for checkbox at runtime Excel VBA
Apparently you need to force Excel VBA to run on time now:
Application.OnTime Now ""
Edited lines of code that works to resolve this issue:
Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Application.OnTime Now, "SetCBAction" '''This is the line that changed
End Sub
And, with this new formatting:
Sub SetCBAction() ''''no longer passing sheet name with new format
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets("Sheet1").OLEObjects '''''No longer passing sheet name with new format
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckBoxes = o.Object
mcolEvents.Add cCBEvents
End If
Next
End Sub
If OLE objects suit your needs then I'm glad you've found a solution.
Are you aware, though, that Excel's Checkbox object could make this task considerably simpler ... and faster? Its simplicity lies in the fact that you can easily iterate the Checkboxes collection and that you can access its .OnAction property. It is also easy to identify the 'sender' by exploiting the Evaluate function. It has some formatting functions if you need to tailor its appearance.
If you're after something quick and easy then the sample below will give you an idea of how your entire task could be codified:
Public Sub RunMe()
Const BOX_SIZE As Integer = 16
Dim ws As Worksheet
Dim cell As Range
Dim cbox As CheckBox
Dim i As Integer, j As Integer
Dim boxLeft As Double, boxTop As Double
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Delete checkboxes
For Each cbox In ws.CheckBoxes
cbox.Delete
Next
'Add checkboxes
For i = 1 To 10
For j = 1 To 2
Set cell = ws.Cells(i, j)
With cell
boxLeft = .Width / 2 - BOX_SIZE / 2 + .Left
boxTop = .Height / 2 - BOX_SIZE / 2 + .Top
End With
Set cbox = ws.CheckBoxes.Add(boxLeft, boxTop, BOX_SIZE, BOX_SIZE)
With cbox
.Name = "CB" & i & j
.Caption = ""
.OnAction = "CheckBox_Clicked"
End With
Next
Next
End Sub
Sub CheckBox_Clicked()
Dim sender As CheckBox
Set sender = Evaluate(Application.Caller)
MsgBox sender.Name & " now " & IIf(sender.Value = 1, "Checked", "Unchecked")
End Sub
I'm new to VBA. I searched for a long time to find a way to have indefinite (varying) amount of ActiveX checkboxes but without the corresponding amount of _click subs but I couldn't make it work.
I thought I found a way around it with Form Controls, but it doesn't seem to work perfectly. This is my code to click cbxReady (a checkbox when a project is ready, can only be ticked if cbxStart is ticked):
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For s = 1 To LastRow - 2
If ActiveSheet.CheckBoxes("cbxReady" & s).Value = 1 Then
ActiveSheet.Cells(s + 2, "A").Interior.Color = RGB(255, 255, 0)
ElseIf ActiveSheet.CheckBoxes("cbxReady" & s).Value = -4146 Then
ActiveSheet.Cells(s + 2, "A").Interior.Color = RGB(218, 238, 243)
End If
Next
And this is cbxStart:
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For s = 1 To LastRow - 2
If ActiveSheet.CheckBoxes("cbxStart" & s).Value = 1 Then
ActiveSheet.Cells(s + 2, "A").Interior.Color = RGB(218, 238, 243)
With ActiveSheet.CheckBoxes("cbxReady" & s)
.Enabled = True
.Value = -4146
End With
ElseIf ActiveSheet.CheckBoxes("cbxStart" & s).Value = -4146 Then
ActiveSheet.Cells(s + 2, "A").Interior.Color = RGB(255, 0, 0)
With ActiveSheet.CheckBoxes("cbxReady" & s)
.Enabled = False
.Value = 2
End With
End If
Next
The idea was that the checkboxes are named cbxStart and cbxReady from 1 to whatever, and when I click cbxStart, the cell in column A (indicating a status of a project by colorcoding) will turn blue, then if I click cbxReady then it will turn yellow. So far so good.
However, this happened:
first row, both are ticked, colour is yellow, all is good;
second row, both are unticked, I tick cbxStart, it turns blue BUT first row turns blue too, as well as its cbxReady unticks.
So basically, even though the checkboxes are named differently, every checkbox reacts to the untick event.
Can someone help me with this please? If it's easier with ActiveX I'd appreciate that too, I'd just like to have one piece of code per checkbox type because I don't know how many I will have and I'd like them to reference one cbxStart_click() and one cbxReady_click().
Thanks!
The trick to doing this is to have a class that handles the Click event.
MyCheckBox Class
Private WithEvents Check As MSForms.CheckBox
Private Sub Check_Click()
MsgBox Check.Object.Value
End Sub
Public Sub SetCheckBox(ck As OLEObject)
Set Check = ck.Object
End Sub
Next you'll need to add each check to new MyCheckBox class and add the MyCheckBox to a module level collection.
Public Checks As Collection
Private Sub AddCheckboxes()
Dim o As OLEObject
Dim ck As MyCheckBox
Set Checks = New Collection
For Each o In ActiveSheet.OLEObjects
Set ck = New MyCheckBox
ck.SetCheckBox o
Checks.Add ck
Next
End Sub
Now whenever a checkbox is clicked the Private Sub Check_Click() will be called.