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
Related
Is there any way to delete named ranges used in chart series when the chart is being deleted?
I use named ranges quite extensively in my daily work, also for charting. When I create charts I often name data ranges and THEN use them for chart series.
I am looking for a way to delete USED named ranges WHEN I delete the chart. I thought about chart "delete" event, but I cannot find any info about it (does it even exist???).
The second issue is how to determine which ranges have been used for chart series? Deleting the named ranges is easy, but how to actually determine, which ranges have been used in chart series?
All help is MUCH appreciated. Apologies but I cannot provide you with any code, as I have no idea how to set things up
Try the next code please. The USED named ranges cannot be extract directly. I used a trick to extract the ranges form SeriesCollection formula. Then compare them with names RefersToRange.Address and delete the matching name. It (now) returns a boolean value in case of match (only to see it in Immediate Window), but not necessary for your purpose. The code also delete the invalid names (having their reference lost).
Edited: I made some researches and I am afraid it is not possible to create a BeforeDelete event... It is an enumeration of events able to be created for a chart object, but this one is missing. I like to believe that I found a solution for your problem, respectively:
Create a class able to enable BeforeRightClick event. Name it CChartClass and write the next code:
Option Explicit
Public WithEvents ChartEvent As Chart
Private Sub ChartEvent_BeforeRightClick(Cancel As Boolean)
Dim msAnswer As VbMsgBoxResult
msAnswer = MsgBox("Do you like to delete the active chart and its involved Named ranges?" & vbCrLf & _
" If yes, please press ""Yes"" button!", vbYesNo, "Chart deletion confirmation")
If msAnswer <> vbYes Then Exit Sub
Debug.Print ActiveChart.Name, ActiveChart.Parent.Name
testDeleteNamesAndChart (ActiveChart.Parent.Name)
End Sub
Create another class able to deal with workbook and worksheet events, name it CAppEvent and copy the next code:
Option Explicit
Public WithEvents EventApp As Excel.Application
Private Sub EventApp_SheetActivate(ByVal Sh As Object)
Set_All_Charts
End Sub
Private Sub EventApp_SheetDeactivate(ByVal Sh As Object)
Reset_All_Charts
End Sub
Private Sub EventApp_WorkbookActivate(ByVal Wb As Workbook)
Set_All_Charts
End Sub
Private Sub EventApp_WorkbookDeactivate(ByVal Wb As Workbook)
Reset_All_Charts
End Sub
Put the next code in a standard module (need to create a classes array in order to start the event for all existing sheet embedded charts):
Option Explicit
Dim clsAppEvent As New CAppEvent
Dim clsChartEvent As New CChartClass
Dim clsChartEvents() As New CChartClass
Sub InitializeAppEvents()
Set clsAppEvent.EventApp = Application
Set_All_Charts
End Sub
Sub TerminateAppEvents()
Set clsAppEvent.EventApp = Nothing
Reset_All_Charts
End Sub
Sub Set_All_Charts()
If ActiveSheet.ChartObjects.Count > 0 Then
ReDim clsChartEvents(1 To ActiveSheet.ChartObjects.Count)
Dim chtObj As ChartObject, chtnum As Long
chtnum = 1
For Each chtObj In ActiveSheet.ChartObjects
Set clsChartEvents(chtnum).ChartEvent = chtObj.Chart
chtnum = chtnum + 1
Next
End If
End Sub
Sub Reset_All_Charts()
' Disable events for all charts
Dim chtnum As Long
On Error Resume Next
Set clsChartEvent.ChartEvent = Nothing
For chtnum = 1 To UBound(clsChartEvents)
Set clsChartEvents(chtnum).ChartEvent = Nothing
Next ' chtnum
On Error GoTo 0
End Sub
Sub testDeleteNamesAndChart(strChName As String)
Dim rng As Range, cht As Chart, sFormula As String
Dim i As Long, j As Long, arrF As Variant, nRng As Range
Set cht = ActiveSheet.ChartObjects(strChName).Chart
For j = 1 To cht.SeriesCollection.Count
sFormula = cht.SeriesCollection(j).Formula: Debug.Print sFormula
arrF = Split(sFormula, ",")
For i = 0 To UBound(arrF) - 1
If i = 0 Then
Set nRng = Range(Split((Split(sFormula, ",")(i)), "(")(1))
Else
Set nRng = Range(Split(sFormula, ",")(i)) '(1)
End If
Debug.Print nRng.Address, matchName(nRng.Address)
Next i
ActiveSheet.ChartObjects(strChName).Delete
End Sub
Private Function matchName(strN As String) As Boolean
Dim Nm As Name, strTemp As String
For Each Nm In ActiveWorkbook.Names
On Error Resume Next
strTemp = Nm.RefersToRange.Address
If Err.Number <> 0 Then
Err.Clear
Nm.Delete
Else
If strN = strTemp Then
Nm.Delete
matchName = True: Exit Function
End If
End If
On Error GoTo 0
Next
End Function
Use the next events code in the ThisWorkbook module:
Option Explicit
Private Sub Workbook_Open()
InitializeAppEvents
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
TerminateAppEvents
End Sub
Please confirm that it worked as you need
I'd like to get an Excel macro running as soon as cell "A500"
becomes visible on the screen when scrolling down/up the worksheet.
I remember reading somewhere about an active-x or standard control
that has an "on scrolling into view" event, so this could be done
by placing a control directly on the worksheet near the desired cell.
Finding this control currently eludes me.
A better way of course would be a cell formula, subclassing still is
a bad idea in the long run i guess :)
Sub temp_01() 'Excel Vba
'user scrolls down from cell "A1"
'when the user reaches cell "A500" show the following message:
MsgBox "Chapter 2"
End Sub
As mentioned above, with the help of the Onupdate event, (catches the mousewheel, not clicking on the scrollbars) (Change Sheetname(s) and Range(s) to yours)
In Class called ClsMonitorOnupdate:
Option Explicit
Private WithEvents objCommandBars As Office.CommandBars
Private rMonitor As Range
Private scrol As Boolean
Public Property Set Range(ByRef r As Range): Set rMonitor = r: End Property
Public Property Get Range() As Range: Set Range = rMonitor: End Property
Private Sub Class_Initialize()
Set objCommandBars = Application.CommandBars
End Sub
Private Sub Class_Terminate()
Set objCommandBars = Nothing
End Sub
Private Sub objCommandBars_OnUpdate()
Dim myrng As Range
If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub
If ActiveSheet.Name <> rMonitor.Parent.Name Then Exit Sub
If TypeName(Selection) <> "Range" Then Exit Sub
If Intersect(Selection, rMonitor) Is Nothing Then Exit Sub
Set myrng = Application.Intersect(ActiveWindow.VisibleRange, ActiveSheet.Range("a500"))
If Not myrng Is Nothing And Not scrol Then scrol = True: MsgBox "chapter"
If myrng Is Nothing And scrol Then scrol = False
End Sub
In the ThisWorkbook section:
Option Explicit
Private sRanges As String
Private cMonitor As ClsMonitorOnupdate
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set cMonitor = Nothing
End Sub
Private Sub Workbook_Open()
Zetaan ActiveSheet
End Sub
Sub Zetuit()
Set cMonitor = Nothing
End Sub
Sub Zetaan(sht As Worksheet)
Select Case sht.Name
Case "Sheet1": sRanges = "A1:ZZ1000"
Case "Other Sheet": sRanges = "A1:ZZ1000"
Case Else: Exit Sub
End Select
Set cMonitor = New ClsMonitorOnupdate
Set cMonitor.Range = Sheets(sht.Name).Range(sRanges)
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Zetaan Sh
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Set cMonitor = Nothing
End Sub
I have written VBA with 3 modules that work perfectly and the userform works as well when I run it from Developer - VBA window. I need to add the userform to my add-in to activate when I need it. I added the 4th module to install the macro
Sub Add_MainframeScrape_Menu()
Dim cbWSMenuBar As CommandBar
Dim muInbound As CommandBarControl
Dim iHelpIndex As Integer
Set cbWSMenuBar = Application.CommandBars("Worksheet Menu Bar")
iHelpIndex = cbWSMenuBar.Controls("Help").Index
Set muInbound = cbWSMenuBar.Controls.Add(Type:=msoControlPopup, Before:=iHelpIndex)
With muInbound
.Caption = "EDIMACROS"
With .Controls.Add '(Type:=msoControlPopup)
.Caption = "EDIMACROS"
.OnAction = "EDI_REPORTS"
End With
End With
End Sub
And I added the below code to the form itself to start when I click on add-ins
Public Sub EDI_MACROS_Initialize()
Me.Show
End Sub
But it's not working please help.
The OnAction should be the name of a Sub (in a regular module) which displays the form, not the name of the form
Sub Add_MainframeScrape_Menu()
Dim cbWSMenuBar As CommandBar
Dim muInbound As CommandBarControl
Dim iHelpIndex As Integer
Set cbWSMenuBar = Application.CommandBars("Worksheet Menu Bar")
iHelpIndex = cbWSMenuBar.Controls("Help").Index
Set muInbound = cbWSMenuBar.Controls.Add(Type:=msoControlPopup, _
Before:=iHelpIndex)
With muInbound
.Caption = "EDIMACROS"
With .Controls.Add '(Type:=msoControlPopup)
.Caption = "EDIMACROS"
.OnAction = "Show_EDI_MACROS"
End With
End With
End Sub
Public Sub Show_EDI_MACROS()
EDI_REPORTS.Show 'assumes your form is named "EDI_REPORTS"
End Sub
Let me preface my question with the fact that I am self taught, so please provide as much detail as possible and bear with me if I need you to explain differently or multiple times.
I created a notation/email generating tool for my team using Microsoft Visual Basic 7.0. The only complaint that I received on it was that many of them are not used to hot keys so they depend on using the mouse but right click didn't work. I was able to find code that creates a pop-up for copy and paste when they use right click, and it works great on the few textboxes that are on the main form itself, however it does not work on the majority of the textboxes as they are in a Multipage.
Does anyone know how to alter the below code to work for textboxes on a Multipage? Also, before it is suggested, I did toy with the idea of moving everything out of the Multipage, however that format is the easiest as there are multiple stages and types of notes/emails that they would need to send at any time, so having tabs available for them to simply click is the most user friendly that I was able to create and that they all agreed on.
Thank you all so much in advance!
Code in the form:
Dim cBar As clsBar
Private Sub UserForm_Initialize()
On Error GoTo Whoa
Application.EnableEvents = False
Set cBar = New clsBar
cBar.Initialize Me
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Code in a Class Module:
Option Explicit
'Popup objects
Private cmdBar As CommandBar
Private WithEvents cmdCopyButton As CommandBarButton
Private WithEvents cmdPasteButton As CommandBarButton
'Useform to use
Private fmUserform As Object
'Control array of textbox
Private colControls As Collection
'Textbox Control
Private WithEvents tbControl As MSForms.TextBox
'Adds all the textbox in the userform to use the popup bar
Sub Initialize(ByVal UF As Object)
Dim Ctl As MSForms.Control
Dim cBar As clsBar
For Each Ctl In UF.Controls
If TypeName(Ctl) = "TextBox" Then
'Check if we have initialized the control array
If colControls Is Nothing Then
Set colControls = New Collection
Set fmUserform = UF
'Create the popup
CreateBar
End If
'Create a new instance of this class for each textbox
Set cBar = New clsBar
cBar.AssignControl Ctl, cmdBar
'Add it to the control array
colControls.Add cBar
End If
Next Ctl
End Sub
Private Sub Class_Terminate()
'Delete the commandbar when the class is destroyed
On Error Resume Next
cmdBar.Delete
End Sub
'Click event of the copy button
Private Sub cmdCopyButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
fmUserform.ActiveControl.Copy
CancelDefault = True
End Sub
'Click event of the paste button
Private Sub cmdPasteButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
fmUserform.ActiveControl.Paste
CancelDefault = True
End Sub
'Right click event of each textbox
Private Sub tbControl_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 And Shift = 0 Then
'Display the popup
cmdBar.ShowPopup
End If
End Sub
Private Sub CreateBar()
Set cmdBar = Application.CommandBars.Add(, msoBarPopup, False, True)
'We’ll use the builtin Copy and Paste controls
Set cmdCopyButton = cmdBar.Controls.Add(ID:=19)
Set cmdPasteButton = cmdBar.Controls.Add(ID:=22)
End Sub
'Assigns the Textbox and the CommandBar to this instance of the class
Sub AssignControl(TB As MSForms.TextBox, Bar As CommandBar)
Set tbControl = TB
Set cmdBar = Bar
End Sub
Get ActiveControl name on a Multipage control
It's necessary to know the multipage's selected Page via a helper function (ActiveControlName) using SelectedItem property and getting the control (its name) from there. Change your button click events as follows:
Relevant button click events in class module clsBar
'Click event of the copy button
Private Sub cmdCopyButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Dim sACN As String
sACN = ActiveControlName(fmUserform) ' find control's name
' Debug.Print sACN & ".Copy"
fmUserform.Controls(sACN).Copy ' << instead of fmUserform.ActiveControl.Copy
CancelDefault = True
End Sub
'Click event of the paste button
Private Sub cmdPasteButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Dim sACN As String
sACN = ActiveControlName(fmUserform)
' Debug.Print sACN & ".Paste"
fmUserform.Controls(sACN).Paste ' << instead of fmUserform.ActiveControl.Paste
CancelDefault = True
End Sub
Helper function called by above click events
Function ActiveControlName(form As UserForm) As String
'cf Site: https://stackoverflow.com/questions/47745663/get-activecontrol-inside-multipage
'Purpose: get ActiveControl
Dim MyMultiPage As MSForms.MultiPage, myPage As MSForms.Page
If form.ActiveControl Is Nothing Then
' do nothing
ElseIf TypeName(form.ActiveControl) = "MultiPage" Then
Set MyMultiPage = form.ActiveControl
Set myPage = MyMultiPage.SelectedItem
ActiveControlName = myPage.ActiveControl.Name
Else
ActiveControlName = form.ActiveControl.Name
End If
End Function
Side note
Suggest to check for the length of selected text strings in case of empty strings to prevent from unwanted results.
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