VBA动态添加事件

[微醺_zZ]

我想做一个九宫格，每个单元格都是由Label动态生成，我想给Label添加鼠标事件，可写完了以后发现只有最后一个单元格有事件，求教各位高手怎么搞定？
定义事件的类

Private WithEvents m_Cell As MSForms.Label
Private m_Form As myframe

Public Sub AddCell(ByVal frmLayout As myframe, ByVal cell As MSForms.Label)
    Set m_Cell = cell
    Set m_Form = frmLayout
End Sub

Private Sub m_Cell_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    m_Form.CellMouseDown m_Cell, Button, Shift, X, Y
End Sub

窗体代码

Private myCells As Collection

Public Sub UserForm_Initialize()
    SetRoomsLayout
End Sub

Private Sub SetRoomsLayout()
    Set myCells = New Collection
    Dim vLeft As Integer, vTop As Integer, tLeft As Integer, tTop As Integer
    Dim i As Integer, j As Integer, key As String
    tLeft = (myframe.Width - 50 * 3) / 2
    tTop = (myframe.Height - 50 * 3) / 2
    For i = 0 To 2
        For j = 0 To 2
            key = i * 100 + j
            vLeft = 0
            vTop = 0
            Dim lblFix As Label
            Set lblFix = myframe.Controls.Add(ProgID_Label, "lblFix_" & key, True)
            If (i <> 0) Then
                vLeft = 50 * i
            End If
            If (j <> 0) Then
                vTop = 50 * j
            End If
            With lblFix
                .Height = 50
                .Width = 50
                .Left = vLeft + tLeft
                .Top = vTop + tTop
                .TextAlign = fmTextAlignCenter
                .BackStyle = fmBackStyleOpaque
                .BorderStyle = fmBorderStyleSingle
                .SpecialEffect = fmSpecialEffectFlat
            End With
            Dim cell As New clsCell
            cell.AddCell vForm, lblFix
            vForm.AddCell key, cell
        Next
    Next
End Sub

Public Sub AddCell(ByVal vKey As String, ByVal vCell As clsCell)
    myCells.Add vCell, vKey
End Sub

Public Sub CellMouseDown(ByVal cell As MSForms.Label, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    MsgBox X
End Sub

[dsd999]

给你贴段 动态添加 Checkbox及事件的代码。

Private Sub CheckBox2_Change()
CheckBox2.Caption = CheckBox2.Value
End Sub
Private Sub CheckBox1_Change()
CheckBox1.Caption = CheckBox1.Value
End Sub

Private Sub CommandButton1_Click()
    Dim i As Integer, CtlName As String
    Dim MyCodeLine(3) As String
    '½ûÖ¹ÆÁÄ»¸üÐÂ
    Application.ScreenUpdating = False
    'Ôڻ¹¤×÷±íÖÐÔö¼ÓÒ»¸öCheckBox
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
                               DisplayAsIcon:=False, Left:=100, Top:=50, Width:=80, Height:= _
                                                                                            20).Select
    '»ñÈ¡¿Ø¼þÃû³Æ
    CtlName = Selection.Name
    'ΪÁ˱ãÓÚÑÝʾ£¬Ö»ÔÊÐíÌí¼Ó9¸öCheckBox
    If VBA.Len(CtlName) > 9 Then
        Selection.Delete
    Else
        'µ÷ÕûÐÂÌí¼ÓµÄ¿Ø¼þµÄλÖ㬱ÜÃâÖصþ
        Selection.Top = 20 + 50 * CInt(VBA.Right$(CtlName, 1))
        'Éú³É¿Ø¼þ´úÂë
        MyCodeLine(1) = "Private Sub " & CtlName & "_Change()"
        MyCodeLine(2) = CtlName & ".Caption=" & CtlName & ".value"
        MyCodeLine(3) = "End Sub"
        For i = 1 To 3
            '²åÈë¿Ø¼þ´úÂë
            ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.InsertLines i, MyCodeLine(i)
        Next
    End If
    Application.ScreenUpdating = True
End Sub

[微醺_zZ]

谢谢你的回答，但你贴的这段根本就没用 我知道我的问题在哪了，我在clsCell里定义了单元格的事件 调用AddCell来设置每个单元格，同时绑定事件 但我的这个类是在方法中声明的局部变量，所以我循环结束之后只绑定了最后一个单元格的事件 Dim cell As New clsCell 就是这句，我定义成全局变量就好了 版主不给力啊……

[dsd999]

抱歉没帮到你。

[微醺_zZ]

我又看了一遍你贴的代码，其实也是一种添加事件的方法 希望各位回帖的能够认真看一下再回帖，这样也许会解决很多问题

[微醺_zZ]

补充一下

cell.AddCell vForm, lblFix
vForm.AddCell key, cell

这两句中的vForm就是myframe

[eb5mj]

楼主，我按照你说的做了，将局部变量改为全局变量，但结果是只有最后一个控件绑定事件成功。 改之前是全都不成功。 我的代码是： 类模块代码

'================================
' 动态创建控件及事件的辅助类
' CControlEvent
'================================
Private WithEvents m_Label As MSForms.Label

Public Sub Init(ctl As MSForms.Label)
    Set m_Label = ctl
End Sub

Private Sub m_Label_Click()
    MsgBox m_Label.Name
End Sub

Private Sub Class_Terminate()
    Set m_Label = Nothing
End Sub

窗体代码 全局声明代码 Dim CtrlEvent As New CControlEvent Dim myLabel As Label 调用代码

    '模拟tab标签页
    For i = 0 To objXML.documentElement.childNodes.length - 1
        Set ChildItem = objXML.documentElement.childNodes.Item(i)
        Set myLabel = UserForm.Controls.Add("Forms.Label.1", "SMC" & i)
        With myLabel
            .Caption = ChildItem.Attributes.Item(0).nodeValue
            .Visible = True
            .ForeColor = &HFFFFFF
            .BackColor = &H786540
            .borderColor = &HB1ABA1
            .BorderStyle = fmBorderStyleSingle
            .Top = 10
            .Left = 10 + 60 * i
            .height = 20
            .width = 60
            .Font.Name = "微软雅黑"
            .Font.Size = 10
            .TextAlign = fmTextAlignCenter
            
        End With

        CtrlEvent.Init myLabel
    Next

求助，谢谢！