Excel VBA如何链接类和控件? [英] Excel VBA how to link a class and a control?
问题描述
我正在将Excel 2003与VBA一起使用,我在工作表上动态创建复选框控件,并希望将VBA控件链接到一个类,以便当用户单击复选框时会触发一个事件,以便我可以执行某些操作.
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.
我的用户类如下:
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.
为什么?
编辑...如果添加复选框,然后进入VB IDE,并从控件列表中选择创建的复选框之一,然后从过程"下拉列表中选择单击",它将插入用于回调的代码如果我在其中添加一个消息框,在单击同一复选框时可以正常工作...那么如何在代码中实现这一点?我尝试记录宏来执行此操作,但未记录任何内容.
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.
推荐答案
由S.Platten编辑,请跳到底部了解如何帮助我解决问题...
Edit by S.Platten, jump to the bottom for how this helped me fix the problem...
由于某些奇怪的原因,VBA不会在添加事件的同一执行周期内为Sheet的ActiveX控件关联事件.因此,我们需要退出添加控件的循环,然后在下一个循环中调用事件添加proc. Application.OnTime
在这里有帮助.
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.
这似乎有些矫kill过正,但它可以起作用:)
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
类模块: 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):
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.
这篇关于Excel VBA如何链接类和控件?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!