读书人

VBA动态平添事件

发布时间: 2013-01-01 14:04:20 作者: rapoo

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


[解决办法]
给你贴段 动态添加 Checkbox及事件的代码。


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


读书人网 >VBA

热点推荐