VBA动态添加事件
我想做一个九宫格，每个单元格都是由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
MyCodeLine(3) = "End Sub"
For i = 1 To 3
'2?è????t′ú??
ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.InsertLines i, MyCodeLine(i)
Next
End If
Application.ScreenUpdating = True
End Sub
cell.AddCell vForm, lblFix
vForm.AddCell key, cell
