VBA动态添加事件

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