I am using Excel 2003 with VBA, I am dynamically creating check box controls on a sheet and want to link the VBA controls to a class so that when a user clicks on a checkbox an event is fired so I can do something.
From what I've read it would seem that creating a user class is the solution, but having tried this I can't get it to work.
My user class looks like this:
Option Explicit
Public WithEvents cbBox As MSForms.checkbox
Private Sub cbBox_Change()
MsgBox "_CHANGE"
End Sub
Private Sub cbBox_Click()
MsgBox "_CLICK"
End Sub
My code to create the checkboxes:
For Each varExisting In objColumns
'Insert the field name
objColumnHeadings.Cells(lngRow, 1).Value = varExisting
'Insert a checkbox to allow selection of the column
Set objCell = objColumnHeadings.Cells(lngRow, 2)
Dim objCBclass As clsCheckbox
Set objCBclass = New clsCheckbox
Set objCBclass.cbBox = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1" _
, Left:=300 _
, Top:=(objCell.Top + 2) _
, Height:=10 _
, Width:=9.6).Object
objCBclass.cbBox.Name = "chkbx" & lngRow
objCBclass.cbBox.Caption = ""
objCBclass.cbBox.BackColor = &H808080
objCBclass.cbBox.BackStyle = 0
objCBclass.cbBox.ForeColor = &H808080
objCheckboxes.Add objCBclass
lngRow = lngRow + 1
Next
The checkboxes are visible in the sheet, but when I click on them, no message box is displayed so the link to the class doesn't seem to be working.
Why?
Edit...If after adding the checkboxes I go into the VB IDE and select one of the created checkboxes from the list of controls, then select Click from the Procedure drop down list, it will insert the code for a call back which if I add a message box to this, works when I click on the same checkbox...so how can I achieve this in code? I've tried recording a macro to do this, nothing was recorded.
Edit by S.Platten, jump to the bottom for how this helped me fix the problem...
Due to some weird reason, VBA doesn't hook up the events for Sheet's ActiveX control in the same execution cycle in which they were added. So, we need to come out of the cycle which added the controls and then invoke the event adding proc in next cycle. Application.OnTime helps here.
Its seems a bit of overkill but it works :)
Option Explicit
Dim collChk As Collection
Dim timerTime
Sub master()
'/ Add the CheckBoxes First
Call addControls
'<< Due to some weird reason, VBA doesn't hook up the events for Sheet's ActiveX control in the same
'execution cycle in which they were added. So, we need to come out of the cycle which added the controls
'and then invoke the event adding proc in next cycle. >>
'/ Start Timer. Timer will call the sub to add the events
Call StartTimer
End Sub
Sub addControls()
Dim ctrlChkBox As MSForms.CheckBox
Dim objCell As Range
Dim i As Long
'Intialize the collection to hold the classes
Set collChk = New Collection
'/ Here Controls are added. No Events, yet.
For i = 1 To 10
Set objCell = Sheet1.Cells(i, 1)
Set ctrlChkBox = Sheet1.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1" _
, Left:=1 _
, Top:=(objCell.Top + 2) _
, Height:=objCell.Height _
, Width:=100).Object
ctrlChkBox.Name = "chkbx" & objCell.Row
Next
End Sub
Sub addEvents()
Dim ctrlChkBox As MSForms.CheckBox
Dim objCBclass As clsCheckBox
Dim x As Object
'Intialize the collection to hold the classes
Set collChk = New Collection
'/ Here we assign the event handler
For Each x In Sheet1.OLEObjects
If x.OLEType = 2 Then
Set ctrlChkBox = x.Object
Set objCBclass = New clsCheckBox
Set objCBclass.cbBox = ctrlChkBox
collChk.Add objCBclass
Debug.Print x.Name
End If
Next
'/ Kill the timer
Call StopTimer
End Sub
Sub StartTimer()
timerTime = Now + TimeSerial(0, 0, 1)
Application.OnTime EarliestTime:=timerTime, Procedure:="addEvents", _
Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=timerTime, Procedure:="addEvents", _
Schedule:=False
End Sub
Class Module: clsCheckBox
Option Explicit
Public WithEvents cbBox As MSForms.CheckBox
Private Sub cbBox_Change()
MsgBox "_CHANGE"
End Sub
Private Sub cbBox_Click()
MsgBox "_CLICK"
End Sub
Edit continued...
The class (clsCheckbox):
Option Explicit
Public WithEvents cbBox As MSForms.checkbox
Private Sub cbBox_Click()
MsgBox "_CLICK"
End Sub
Module1
Public objCheckboxes As Collection
Public tmrTimer
Public Sub addEvents()
Dim objCheckbox As clsCheckbox
Dim objMSCheckbox As Object
Dim objControl As Object
Set objCheckboxes = New Collection
For Each objControl In Sheet1.OLEObjects
If objControl.OLEType = 2 _
And objControl.progID = "Forms.CheckBox.1" Then
Set objMSCheckbox = objControl.Object
Set objCheckbox = New clsCheckbox
Set objCheckbox.cbBox = objMSCheckbox
objCheckboxes.Add objCheckbox
End If
Next
Call stopTimer
End Sub
Public Sub startTimer()
tmrTimer = Now + TimeSerial(0, 0, 1)
Application.OnTime EarliestTime:=tmrTimer _
, Procedure:="addEvents" _
, Schedule:=True
End Sub
Public Sub stopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=tmrTimer _
, Procedure:="addEvents" _
, Schedule:=False
End Sub
The code in the sheet that adds the controls:
Dim objControl As MSForms.checkbox
For Each varExisting In objColumns
'Insert the field name
objColumnHeadings.Cells(lngRow, 1).Value = varExisting
'Insert a checkbox to allow selection of the column
Set objCell = objColumnHeadings.Cells(lngRow, 2)
Set objControl = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1" _
, Left:=300 _
, Top:=(objCell.Top + 2) _
, Height:=10 _
, Width:=9.6).Object
objControl.Name = "chkbx" & lngRow
objControl.Caption = ""
objControl.BackColor = &H808080
objControl.BackStyle = 0
objControl.ForeColor = &H808080
lngRow = lngRow + 1
Next
This isn't the entire project, but enough to demonstrate the workings.
You are currently using ActiveX controls. Yet, ActiveX controls are bound to specific naming conventions. For example: if you insert an ActiveX button onto a sheet and name it btnMyButton then the sub must be named btnMyButton_Click. The same applies to checkboxes. If you insert a new checkbox with the name CheckBox2 then the sub's name must be CheckBox2_Click. In short, there cannot be a sub with the name cbBox_Change associated to any ActiveX checkbox.
So, what you really need (with ActiveX controls) is a way to change the VBA code on a sheet. But thus far I have never come across any such code (VBA code to change VBA code on a sheet).
A much easier route would be if you'd be willing to use form controls instead.
The following sub will create a (form control) checkbox and assign the macro tmpSO to it. The sub tmpSO (unlike subs for ActiveX controls) does not need to reside on the sheet but can be in any module.
Sub Insert_CheckBox()
Dim chk As CheckBox
Set chk = ActiveSheet.CheckBoxes.Add(390.75, 216, 72, 72)
chk.OnAction = "tmpSO"
End Sub
Since a from control is calling the sub tmpSO you can use Application.Caller in that sub and thereby know which checkbox has been calling this sub.
Sub tmpSO()
Debug.Print Application.Caller
End Sub
This will return the name of the CheckBox. So, you can use this one sub for all of your checkboxes any dynamically handle them based on their names (possibly using a Case Select).
Here is another example for tmpSO:
Sub tmpSO()
With ThisWorkbook.Worksheets(1).CheckBoxes(Application.Caller)
MsgBox "The checkbox " & Application.Caller & Chr(10) & _
"is currently " & IIf(.Value = 1, "", "not") & " checked."
End With
End Sub
Related
I have some code that creates and deletes a cell menu control.
This control should only be displayed on a certain worksheet, so when the user switches sheet it gets deleted.
The problem I'm having is that part of the code that is called from the control changes the selected sheet and this causes a Method 'Delete' of object '_CommandBarButton' failed error.
I'm guessing this is because the button is still active while the code is executing, so it can't be deleted.
Does anyone know of any work around for this?
To use the code create a workbook with two worksheets with codenames Sheet1 and Sheet2.
I'm using Excel for Office 365 ProPlus, but I don't think that's part of the issue here.
The code I have:
ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteFromCellMenu
End Sub
Private Sub Workbook_Open()
If ActiveSheet.CodeName = "Sheet1" Then AddCellToMenu
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.CodeName = "Sheet1" Then
AddCellToMenu
End If
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
DeleteFromCellMenu
End Sub
Normal Module
The error occurs near the end of the last procedure (ctrl.Delete).
'''''''''''''''''
'This is the procedure called by the control button.
'''''''''''''''''
Sub Test()
Sheet2.Select
End Sub
Sub AddCellToMenu()
Dim Menu(0 To 1) As Variant
Dim vItm As Variant
Dim ContextMenu As CommandBar
Menu(0) = "Cell"
Menu(1) = "List Range Popup"
'Delete the controls first to avoid duplicates
Call DeleteFromCellMenu
For Each vItm In Menu
Set ContextMenu = Application.CommandBars(vItm)
'Add the control button.
With ContextMenu.Controls.Add(Type:=msoControlButton, Before:=1)
.Caption = "Create Pre-Alert"
.Tag = "Customs_Tag"
.FaceId = 1392
.OnAction = "'" & ThisWorkbook.Name & "'!" & "Test"
End With
ContextMenu.Controls(2).BeginGroup = True
Next vItm
End Sub
Sub DeleteFromCellMenu()
Dim Menu(0 To 1) As Variant
Dim vItm As Variant
Dim ContextMenu As CommandBar
Dim ctrl As CommandBarControl
Menu(0) = "Cell"
Menu(1) = "List Range Popup"
For Each vItm In Menu
'Set ContextMenu to the Cell menu
Set ContextMenu = Application.CommandBars(vItm)
'Delete custom controls with the Tag : Customs_Tag
For Each ctrl In ContextMenu.Controls
If ctrl.Tag = "Customs_Tag" Then
ctrl.Delete '<<<ERROR OCCURS HERE.
End If
Next ctrl
Next vItm
End Sub
My first post here, but have been successfully sourcing solutions and ideas from this website for a while now. So thanks for the collection of solutions and ideas.
Basically, I have a spread sheet application requiring the first column, Column A, to be filled with "Active X" buttons in every cell, looping through for a given quantity. I have posted one such working solution below which makes use of "form type buttons" and a Modules. This exemplifies what I consider my most favored example with working buttons. Once operational the column of buttons will correspond to relative data on the same row, and when clicked will open corresponding folders, and userforms in later developments.
The second post uses the Range function, but obviously doesn't incorporate any buttons to interactive with. However, a mouse click over this Range will obviously activate any code from within the Worksheet_Selection Change procedure...Sorry just stating the obvious!
What I have been trying to achieve is a version of code employing "activeX" Command Buttons, but after having studied some great tutorials and poured over a range of programing concepts, I still fail miserably to employ OLEObjects.
How to add a button programmatically in VBA next to some sheet cell data?
Sheet 1 Procedure:
Sub ColumnA_Buttons()
Dim buttons As Button
Dim rng As Range
Dim LineQty As Variant
Application.ScreenUpdating = False
ActiveSheet.buttons.Delete
LineQty = 5
For i = 1 To LineQty
Set rng = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
Set buttons = ActiveSheet.buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
With buttons
.OnAction = "Buttons"
.Caption = "Line " & i
.Name = "Line " & i
End With
Next i
Application.ScreenUpdating = True
End Sub
Public Click_Button As Variant ' Make Variable Public for Userform1
'
Form Button Module:
Sub Line_Buttons()
Click_Button = Application.Caller
MsgBox Click_Button & " was Clicked"
UserForm1.Show 'Launch custom userform
End Sub
And the next option to be considered is a range detection
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' e.g., range(A1:E1) is clicked
If Not Application.Intersect(Target, Range("B2:B12")) Is Nothing Then
MsgBox "You clicked " & Target.Address
End If
End Sub
Ok. I'm posting some code that I've been working on based on this post here: Multiple active X checkboxes... . It seems I've now come to the same stand still they did as descibed in their last post :
"Yes it is individual checkboxes. You can emulate control arrays in
VBA so that each checkbox uses the same click event code, but that is
probably overkill IMO. "
And if I read Jason's post above, this is what he's questioning regarding the event code.
Any assistance welcomed in completing this code, as I have Not yet seen a working example which interlocks it to a single event, as per the form button module above.
Sub Macro1()
Dim objCmdBtn As Object
Dim i As Integer
Dim Rnge As Range
Set ColumnRange = Range("A:A") ' Set width & height of column A
ColumnRange.ColumnWidth = 5: ColumnRange.RowHeight = 15.75
'Delete previous objCmdBtn
For Each objCmdBtn In ActiveSheet.OLEObjects
If TypeName(objCmdBtn.Object) = "CommandButton" Then objCmdBtn.Delete
Next objCmdBtn 'TypeName Function returns the data-type about a variable - TypeName(varname is objCmdBtn)
With ActiveSheet
For i = 1 To 25
Set Rnge = ActiveSheet.Range(Cells(i + 1, 1), Cells(i + 1, 1))
Set objCmdBtn = Sheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=Rnge.Left, _
Top:=Rnge.Top, _
Width:=Rnge.Width, _
Height:=Rnge.Height)
With objCmdBtn
'set a String value as object's name
'.Name = "CommandButton1"
With .Object
.Caption = i
With .Font
.Name = "Arial"
.Bold = True
.Size = 7
.Italic = False
.Underline = False
End With
End With
End With
Next
End With
End Sub
Here is an example of ActiveX buttons being created and coded to run. It may take some small tweaks, but will get the job done.
Sub CreateButton()
Dim Obj As Object
Dim Code As String
Dim cellLeft As Single
Dim cellTop As Single
Dim cellwidth As Single
Dim cellheight As Single
Dim LineQty as Integer
Sheets("Sheet1").Select
LineQty = 5
For i = 1 To LineQty
Set rng = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
cellLeft = rng.Left
cellTop = rng.Top
cellwidth = rng.Width
cellheight = rng.Height
'create button
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=cellLeft, Top:=cellTop, Width:=cellWidth, Height:=cellHeight)
Obj.Name = "TestButton"
'button text
ActiveSheet.OLEObjects(1).Object.Caption = "Test Button"
'macro text to be added possibly by array?
Code = "Private Sub TestButton_Click()" & vbCrLf
Code = Code & "Call Tester" & vbCrLf
Code = Code & "End Sub"
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines
.CountOfLines + 1, Code
End With
Next i
End Sub
Sub Tester()
MsgBox "You have clicked on the test button"
End Sub
Note In order for this to not error on me, I had to go to the trust center and to trust center settings and macro settings and check the box "Trust Access to the VBA Project Object Model"
A form I am working with has 10 checkboxes, with values 1 through 10, used to answer a multiple choice question.
Multiple values are technically possible (clicking on multiple boxes), but they are not allowed (while filling, only one value should be given). I cannot modify this form so I have to work with this setup.
I need to extract the given choice and paste it into a different worksheet.
Using this question I can extract the value of every single checkbox and develop a IF Loop.
If ExtractionSheet.Shapes("Check Box 1").OLEFormat.Object.Value = 1 Then
Database.Cells(5, 9).Value = 1
ElseIf ExtractionSheet.Shapes("Check Box 2").OLEFormat.Object.Value = 1 Then
Database.Cells(5, 9).Value = 2
ElseIf ExtractionSheet.Shapes("Check Box 3").OLEFormat.Object.Value = 1 Then
Database.Cells(5, 9).Value = 3
...
However, this does not look very efficient (I have 3 sets of 1-10 checkboxes per form and 100+ forms). Given the setup, I cannot figure out a better way to do it.
How can I improve the extraction without using an IF loop?
EDIT A better description of the form, following comments
This is a simple excel worksheet, in which 3 groups of 10 check box elements were pasted.
Each form/worksheet relates to a single item. During the assessment, for each item we will assign a value between 1 and 10 to Property 1 (first 10 check boxes), a value between 1 and 10 to Property 2 (second 10 check boxes) and a value between 1 and 10 to Property 3 (third 10 check boxes).
I will do the filling (physically clicking the box) while in front of the client who is giving me data to fill it. The possibility of clicking multiple boxes naturally exists; I do not think it will be critical because many people will be looking at the screen while I do it, but I can always add a check later on.
Updated after comments:
I have used the following naming convention for the checkboxes (Using just e.g. A1 is a cell reference and could cause problems)
ChkBox_A1
Where the first part denotes that it is a checkbox (ChkBox), second the group A and third the position 1. With this naming convention and how the code is currently written you will be able to have a maximum of 26 groups (i.e. one for every letter of the alphabet)
I use the immediate window for the results which can be accessed in the VBA editor by going to View->Immediate Window or Ctrl+G
This code will handle single select per group. i.e. If a checkbox is selected in the group it will un-select all other ones
For a worksheet
This code goes in the worksheet object
Replace all of the click statements (e.g. ChkBox_A1_Click() with reference to your own. This can be easily done by calling the GenerateChkBoxClickStmt sub and copying and pasting the output in the immediate window into your code (replacing my ones)
Option Explicit
Dim ChkBoxChange As Boolean
Private Sub ChkBox_A1_Click()
If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_A1
End Sub
Private Sub ChkBox_A2_Click()
If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_A2
End Sub
Private Sub ChkBox_B1_Click()
If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_B1
End Sub
Private Sub UnselectPreviousChkBox(selected As Object)
Dim ChkBox As OLEObject
ChkBoxChange = True
For Each ChkBox In Me.OLEObjects
If ChkBox.progID = "Forms.CheckBox.1" Then
If ChkBox.Name <> selected.Name And Mid(ChkBox.Name, 8, 1) = Mid(selected.Name, 8, 1) Then
ChkBox.Object.Value = False
End If
End If
Next ChkBox
ChkBoxChange = False
End Sub
Private Sub GenerateChkBoxClickStmt()
Dim ChkBox As OLEObject
' Copy and paste output to immediate window into here
For Each ChkBox In Me.OLEObjects
If ChkBox.progID = "Forms.CheckBox.1" Then
Debug.Print "Private Sub " & ChkBox.Name & "_Click()"
Debug.Print vbTab & "If ChkBoxChange = False Then UnselectPreviousChkBox Me." & ChkBox.Name
Debug.Print "End Sub"
End If
Next ChkBox
End Sub
Producing the following:
This code goes into a Module
Option Explicit
Private Function GetChkBoxValues(ChkBoxGroup As Variant) As Long
Dim ChkBox As OLEObject
' Update with your sheet reference
For Each ChkBox In ActiveSheet.OLEObjects
If ChkBox.progID = "Forms.CheckBox.1" Then
If ChkBox.Object.Value = True And Mid(ChkBox.Name, 8, 1) = ChkBoxGroup Then
GetChkBoxValues = Right(ChkBox.Name, Len(ChkBox.Name) - (Len("ChkBox_") + 1))
Exit For
End If
End If
Next ChkBox
End Function
Public Sub GetSelectedChkBoxes()
Dim ChkBoxGroups() As Variant
Dim Grp As Variant
ChkBoxGroups = Array("A", "B", "C")
For Each Grp In ChkBoxGroups
Debug.Print "Group " & Grp, GetChkBoxValues(Grp)
Next Grp
End Sub
By running the GetSelectedChkBoxes the code will output to the immediate window:
For a UserForm
Similarly the statements for the click events can be generated by uncommenting the line in the Userform_Initalize sub
Option Explicit
Dim ChkBoxChange As Boolean
Private Function GetChkBoxValues(Group As Variant) As Long
Dim ChkBox As Control
For Each ChkBox In Me.Controls
If TypeName(ChkBox) = "CheckBox" Then
If ChkBox.Object.Value = True And Mid(ChkBox.Name, 8, 1) = Group Then
GetChkBoxValues = Right(ChkBox.Name, Len(ChkBox.Name) - (Len("ChkBox_") + 1))
Exit For
End If
End If
Next ChkBox
End Function
Private Sub UnselectPreviousChkBox(selected As Control)
Dim ChkBox As Control
ChkBoxChange = True
For Each ChkBox In Me.Controls
If TypeName(ChkBox) = "CheckBox" Then
If ChkBox.Name <> selected.Name And Mid(ChkBox.Name, 8, 1) = Mid(selected.Name, 8, 1) Then
ChkBox.Value = False
End If
End If
Next ChkBox
ChkBoxChange = False
End Sub
Private Sub ChkBox_A1_Click()
If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_A1
End Sub
Private Sub ChkBox_A2_Click()
If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_A2
End Sub
Private Sub ChkBox_B1_Click()
If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_B1
End Sub
Private Sub userform_initialize()
' Comment out once written
' GenerateChkBoxClickStmt
End Sub
Private Sub UserForm_Terminate()
Dim ChkBoxGroups() As Variant
Dim Grp As Variant
ChkBoxGroups = Array("A", "B", "C")
For Each Grp In ChkBoxGroups
Debug.Print "Group " & Grp, GetChkBoxValues(Grp)
Next Grp
End Sub
Private Sub GenerateChkBoxClickStmt()
Dim ChkBox As Control
' Copy and paste output to immediate window into here
For Each ChkBox In Me.Controls
If TypeName(ChkBox) = "CheckBox" Then
Debug.Print "Private Sub " & ChkBox.Name & "_Click()"
Debug.Print vbTab & "If ChkBoxChange = False Then UnselectPreviousChkBox Me." & ChkBox.Name
Debug.Print "End Sub"
End If
Next ChkBox
End Sub
Producing:
and outputting the following on exit:
I have a to do list in excel. When a check box is checked a macro is ran that selects a specific cell and adds values to offsets of that cell. The problem is I have 600 check boxes and they all need their own code to reference the correct cells.
private sub checkbox1_click ()
Range ("I2").offset(0,3).value= "hello world"
Sub end
I want something like this:
Range ("location of checkbox I just checked").offset(0,3).value= "hello world"
This would be easier if you are using ActiveX control checkboxes instead of Form control.
With ActiveX control checkboxes, you can refer to the object as a part of Me, which points to the worksheet itself and use something like this:
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = True Then
Me.CheckBox1.TopLeftCell.Offset(0, 3).Value = "hello world"
End If
End Sub
If you can't use ActiveX controls, please let me know and I can adjust my answer. Note that you could also look at more information on how to make a checkbox refer to itself by looking at the answer to this question.
In the answer from PeterT, you can also see how to use a Class Module to avoid the problem of having one macro per checkbox. Here, I'm copying the relevant part of the answer:
[...] Create a class module that you can instantiate for any number of
CheckBoxes.
Code for Class module MyCheckBoxClass
Dim WithEvents cbControl As MSForms.CheckBox
Private controlName As String
Public Sub cbControl_Click()
Debug.Print controlName & " is now " & cbControl.Value
If cbControl.Value = True Then
Range("CheckBoxCount") = Range("CheckBoxCount") + 1 'choose to store on the sheet
groupCheckBoxCount = groupCheckBoxCount + 1 'or in a variable
Else
Range("CheckBoxCount") = Range("CheckBoxCount") - 1
groupCheckBoxCount = groupCheckBoxCount - 1
End If
End Sub
Public Sub Attach(newCB As MSForms.CheckBox, newName As String)
Set cbControl = newCB
controlName = newName
End Sub
Private Sub Class_Initialize()
controlName = ""
End Sub
Code in a regular code module:
Public groupClickCount As Integer
Private cbCollection As Collection
Public Sub SetUpControlsOnce()
Dim thisCB As MyCheckBoxClass
Dim ctl As OLEObject
Dim cbControl As MSForms.CheckBox
If cbCollection Is Nothing Then
Set cbCollection = New Collection
End If
For Each ctl In ThisWorkbook.Sheets("Sheet1").OLEObjects
If TypeName(ctl.Object) = "CheckBox" Then
'--- this is an ActiveX CheckBox
Set thisCB = New MyCheckBoxClass
thisCB.Attach ctl.Object, ctl.name
cbCollection.Add thisCB
End If
Next ctl
End Sub
Of course, you would have to replace "Sheet1" with the appropriate name for your sheet and
If cbControl.Value = True Then
Range("CheckBoxCount") = Range("CheckBoxCount") + 1 'choose to store on the sheet
groupCheckBoxCount = groupCheckBoxCount + 1 'or in a variable
Else
Range("CheckBoxCount") = Range("CheckBoxCount") - 1
groupCheckBoxCount = groupCheckBoxCount - 1
End If
With
If cbControl.Value = True Then
cbControl.TopLeftCell.Offset(0, 3).Value = "hello world"
End If
And finally, I would suggest to run the SetUpControlsOnce macro when you open the workbook by including it in the Open Event of the Workbook Object (Thisworkbook). ie.:
Private Sub Workbook_Open()
Call SetUpControlsOnce
End Sub
I have an excel spreadsheet that sets a cell's value to the number of checked boxes in a group. I would like to assign a macro to each that looks like this:
Sub clickedBox()
If thisBox(or however you would do it).Checked = True Then
Range("D9").Value = Range("D9").Value + 1
Else
Range("D9").Value = Range("D9").Value - 1
End If
End Sub
The cell defaults to 0 and all the boxes default to unchecked. That way, ticking a box ups the count, and unticking it knocks it down one and it can never go below zero or higher than the number of boxes.
I realize that I should also make it so that the macro triggers when a checkbox's state is changed not only when it's clicked, but I want to make sure this is possible first.
Is there a way to have a checkbox just reference itself like that?
It really depends if you're tied into ActiveX controls or Form Controls. Either can work, and either path likely directs how to clearly implement it.
Using ActiveX Controls (checkboxes):
You have two options to code your "click handlers" for ActiveX controls. The first is hard-coding a public sub for each control:
control on Thisworkbook.Sheets("Sheet1"): CheckBox1
code in Excel Object Sheet1:
Private groupCheckBoxCount As Integer
Private Sub CheckBox1_Click()
Debug.Print "Control on " & Me.Name & " is now " & Me.CheckBox1.Value
RegisterCheckedValue Me.CheckBox1.Value
End Sub
Private Sub RegisterCheckedValue(cbVal As Boolean)
If cbVal = True Then
Range("CheckBoxCount") = Range("CheckBoxCount") + 1 'choose to store on the sheet
groupCheckBoxCount = groupCheckBoxCount + 1 'or in a variable
Else
Range("CheckBoxCount") = Range("CheckBoxCount") - 1
groupCheckBoxCount = groupCheckBoxCount - 1
End If
End Sub
Then if you have ten checkboxes, you'll have ten CheckBox(x)_Click subs, each specifically tied to a single ActiveX control. Each of these click handlers can increment or decrement your counter in stored in a worksheet cell (or in a module private variable).
The second option is to create a class module that you can instantiate for any number of CheckBoxes.
code for class module MyCheckBoxClass
Dim WithEvents cbControl As MSForms.CheckBox
Private controlName As String
Public Sub cbControl_Click()
Debug.Print controlName & " is now " & cbControl.Value
If cbControl.Value = True Then
Range("CheckBoxCount") = Range("CheckBoxCount") + 1 'choose to store on the sheet
groupCheckBoxCount = groupCheckBoxCount + 1 'or in a variable
Else
Range("CheckBoxCount") = Range("CheckBoxCount") - 1
groupCheckBoxCount = groupCheckBoxCount - 1
End If
End Sub
Public Sub Attach(newCB As MSForms.CheckBox, newName As String)
Set cbControl = newCB
controlName = newName
End Sub
Private Sub Class_Initialize()
controlName = ""
End Sub
code in a regular code module:
Public groupClickCount As Integer
Private cbCollection As Collection
Public Sub SetUpControlsOnce()
Dim thisCB As MyCheckBoxClass
Dim ctl As OLEObject
Dim cbControl As MSForms.CheckBox
If cbCollection Is Nothing Then
Set cbCollection = New Collection
End If
For Each ctl In ThisWorkbook.Sheets("Sheet1").OLEObjects
If TypeName(ctl.Object) = "CheckBox" Then
'--- this is an ActiveX CheckBox
Set thisCB = New MyCheckBoxClass
thisCB.Attach ctl.Object, ctl.name
cbCollection.Add thisCB
End If
Next ctl
End Sub
Using Form Controls (checkboxes):
While there are several ways to catch the click event for a Form checkbox, the simplest is to connect ALL checkboxes in a group to a single macro:
Public groupClickCount As Integer
Public Sub cbControl_Click()
'--- loop through all the controls on the form and filter for
' only checkboxes, then count up how many are checked
Dim ctl As Shape
Dim checkCount As Integer
checkCount = 0
For Each ctl In ActiveSheet.Shapes
If ctl.Type = msoFormControl Then
On Error Resume Next
If ctl.ControlFormat = xlCheckBox Then
If ctl.ControlFormat.Value = 1 Then
checkCount = checkCount + 1
Else
checkCount = checkCount - 1
End If
End If
End If
Next ctl
Range("CheckBoxCount") = checkCount 'choose to store on the sheet
groupClickCount = checkCount 'or in a variable
End Sub
Either solution can be adapted in many ways, depending on your needs and how you'd like to track your checkboxes.