1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
|
***** Feuille FrmControlArray *****
Option Explicit
Option Compare Text
Private oControlArray() As CtrlArray
Private Const clControlCount As Long = 5
Public Sub DoSomethingWithClick(LabelText As String)
MsgBox LabelText
End Sub
Private Sub CmdClose_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim ThisBox As Long, NewLabel As Control
ReDim oControlArray(1 To clControlCount)
For ThisBox = 1 To clControlCount
Set NewLabel = Me.Controls.Add("Forms.Label.1")
With NewLabel
.Left = 10
.Top = 15 * ThisBox
.Height = 12
.Width = 100
.Visible = True
.Caption = "LABEL : " & ThisBox
.BorderStyle = 0
End With
Set oControlArray(ThisBox) = New CtrlArray
oControlArray(ThisBox).Initialise NewLabel, ThisBox
Next
Set NewLabel = Nothing
End Sub
Private Sub UserForm_Terminate()
Dim ThisBox As Long
For ThisBox = 1 To clControlCount
Set oControlArray(ThisBox) = Nothing
Next
End Sub
***** Classe CtrlArray *****
Option Explicit
Option Compare Text
Private WithEvents zoLabel As MSForms.Label
Private zlIndex As Long
Private Sub zoLabel_Click()
Call FrmControlArray.DoSomethingWithClick(zoLabel.Caption)
End Sub
Private Sub Class_Terminate()
Set zoLabel = Nothing
End Sub
Sub Initialise(oControl As Object, lControlIndex As Long)
zlIndex = lControlIndex
Set zoLabel = oControl
End Sub
Property Get Index() As Long
Index = zlIndex
End Property
Function Control(sName As String) As Object
Set Control = zoLabel
End Function
Private Sub zoLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With zoLabel
.ForeColor = vbBlue
.Font.Underline = True
End With
End Sub |
Partager