Excel VBA如何链接一个类和一个控件？

我正在使用Excel 2003与VBA，我dynamic地创build一个工作表上的checkbox控件，并希望链接到一个类的VBA控件，以便当用户点击checkbox事件被激发，所以我可以做一些事情。

从我读过的东西看来，创build一个用户类是解决scheme，但尝试过这个我不能得到它的工作。

我的用户类看起来像这样：

Option Explicit Public WithEvents cbBox As MSForms.checkbox Private Sub cbBox_Change() MsgBox "_CHANGE" End Sub Private Sub cbBox_Click() MsgBox "_CLICK" End Sub 

我的代码来创buildcheckbox：

  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 

checkbox在工作表中是可见的，但是当我单击它们时，没有显示消息框，所以到类的链接似乎不工作。

为什么？

编辑…如果添加checkbox后，我进入VB IDE，并从控件列表中select一个创build的checkbox，然后从过程下拉列表中select单击，它将插入callback的代码，如果我添加一个消息框到这个，当我点击相同的checkbox工作…所以我怎么能在代码中实现这一点？ 我试图录制一个macros来做到这一点，没有任何logging。

Answer 1

由S.Platten编辑，跳到底部，了解如何帮助我解决问题。

由于一些奇怪的原因，VBA不会在与添加它们相同的执行周期中为Sheet的ActiveX控件挂接事件。 所以，我们需要从添加控件的循环中退出，然后在下一个循环中调用添加proc的事件。 Application.OnTime在这里帮助。

它似乎有点矫枉过正，但它的工作:)

 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 

类模块： 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 

编辑继续…

类（clsCheckbox）：

  Option Explicit Public WithEvents cbBox As MSForms.checkbox Private Sub cbBox_Click() MsgBox "_CLICK" End Sub 

模块1

  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 

添加控件的表单中的代码：

  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 

这不是整个项目，但足以certificate这些工作。

Answer 2

您正在使用ActiveX控件。 然而，ActiveX控件绑定到特定的命名约定。 例如：如果在工作表中插入一个ActiveXbutton并将其命名为btnMyButton则该子项必须命名为btnMyButton_Click 。 这同样适用于checkbox。 如果插入名称为CheckBox2的新checkbox，那么该子名称必须是CheckBox2_Click 。 简而言之，不能有与任何ActiveXcheckbox关联的名称为cbBox_Change的子。

所以，你真正需要什么（使用ActiveX控件）是一种方法来改变工作表上的VBA代码。 但到目前为止，我从来没有遇到过任何这样的代码（VBA代码来更改VBA代码在一张纸上）。

如果你愿意使用表单控件，那么路线要简单得多。

下面的子将创build一个（表单控件）checkbox，并为其分配macros tmpSO 。 sub tmpSO （不像ActiveX控件的子tmpSO ）不需要驻留在表单上，​​但可以在任何模块中。

 Sub Insert_CheckBox() Dim chk As CheckBox Set chk = ActiveSheet.CheckBoxes.Add(390.75, 216, 72, 72) chk.OnAction = "tmpSO" End Sub 

由于from control调用子tmpSO你可以在该子使用Application.Caller ，从而知道哪个checkbox已经调用这个子。

 Sub tmpSO() Debug.Print Application.Caller End Sub 

这将返回CheckBox的名称。 所以，你可以使用这一个子的所有checkbox任何dynamic处理他们的名字（可能使用一个Case Select ）。

这是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