使用vba为动态创建的活动x复选框添加代码

这段代码将帮助我根据我的要求创建许多active-x复选框，如图中所示

选中图像，单击必要的复选框后，然后单击命令按钮“导出nfr”，与所选复选框对应的行应复制到另一张图纸，是否有方法为该操作添加代码

很抱歉编辑了这个问题

通过创建事件沉没类（如clsCustomCheckBox），使用“自定义”复选框

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

然后，您可以添加新的，然后执行类似于下面的操作

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

---

您可以切换到

窗体

控件

而不是

ActiveX

控件，并利用其

操作

属性，将同一子控件分配给所有复选框

详情如下:

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

---

使用

和

以及

If

语句中的

或

。尽量不要把它们放在窝里。

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

Sub CheckBoxClick()
    With ActiveSheet.CheckBoxes(Application.Caller) '<--| reference caller checkbox
        MsgBox "hello from " & .Name & " place at cell " & .TopLeftCell.Address
    End With
End Sub