Add codes for dynamically created Active x-check boxes using vba - vba

Question

Dim t As Long
Dim u As Long
Dim v As Long
Dim q As Long
Dim p As Long
t = 1
u = 1
Do
If Sheet2.Range("D" & t).Value = "" Then
If Sheet2.Range("D" & t + 1).Value = "" Then
If Sheet2.Range("D" & t + 2).Value = "" Then
If Sheet2.Range("D" & t + 3).Value = "" Then
If Sheet2.Range("D" & t + 4).Value = "" Then
If Sheet2.Range("C" & t).Value = "" Then
Exit Do
End If
End If
End If
End If
End If
End If
If Not Sheet2.Range("D" & t).Value = "" Then
If Not Sheet2.Range("D" & t).Value = "Description" Then
v = Sheet2.Range("A" & 1 & ":" & "A" & t - 1).Height
q = Sheet2.Range("A" & t).Height
p = v + (q / 2) - 5
Set obj = Sheet2.OLEObjects.Add("Forms.checkbox.1")
With obj
.Width = 10
.Top = p
.Left = 875
.Height = 10
End With
u = u + 1
End If
End If
t = t + 1
Loop
This Code will help me to create many active-x check boxes as per my requirement as u can see in the image.
check the image,after i click the necessary check boxes,and then the command button "export the nfr", the row corresponding to the selected check box should be copied to another sheet, is there any way to add codes for that manipulation
sorry for editing the question
https://i.stack.imgur.com/YF2U2.png

Answer 1

Use a "custom" check box, by creating an event sunk class, such as this, clsCustomCheckBox
Option Explicit
Public WithEvents cb As msforms.CheckBox
Public Sub init(cbInit As msforms.CheckBox)
Set cb = cbInit
End Sub
Private Sub cb_Click() ' or the _Change event....
' Your code here
End Sub
You could then add your new ones, afterwards doing something similar to the below
Private c As Collection
Sub testcb()
Dim o As Object
Dim cb As New clsCustomCheckBox
Set o = ActiveSheet.OLEObjects(1)
cb.init o.Object
Set c = New Collection
c.Add cb
End Sub

Answer 2

you could switch to a Form Control instead of an ActiveX one and take advantage of its OnAction property and assign the same sub to all checkboxes
as follows:
Sub Macro2()
Dim t As Long, u As Long, v As Long, q As Long, p As Long
t = 2 '<--| start from 2 otherwise subsequent "A" & (t - 1) would return "A0"!
u = 1
With Sheet2
Do
If WorksheetFunction.CountA(.Cells(t, "D").Resize(5), .Cells(t, "C")) < 6 Then Exit Do
If Not .Cells(t, "D").Value = "Description" Then
v = .Range("A1", "A" & (t - 1)).Height
q = .Cells(t, "A").Height
p = v + (q / 2) - 5
With .CheckBoxes.Add(875, p, 10, 10) '<--| add a 'Form' checkbox
.OnAction = "CheckBoxClick" '<--| current checkbox will "react" calling 'CheckBoxClick()' sub
End With
u = u + 1 '<--| what is this for?
End If
t = t + 1
Loop
End With
End Sub
then you only have to type your CheckBoxClick() sub, for instance:
Sub CheckBoxClick()
With ActiveSheet.CheckBoxes(Application.Caller) '<--| reference caller checkbox
MsgBox "hello from " & .Name & " place at cell " & .TopLeftCell.Address
End With
End Sub