[VBA-A]Détection souris sur un objet.
Salut à tous,
Je tente de construire une petite application avec des objets (des Labels) dynamiques. J'ai réussi jusqu'à maintenant à partir de code trouvé sur Internet à faire à peu près tout ce dont j'ai besoin sauf une petite chose.
Ce que je tente de faire, c'est de mettre en surbrillance le texte d'un label lorsque la souris passe dessus exactement comme un URL dans une page Web.
La première partie fonctionne, c'est à dire que le texte devient en bleu et souligné quand la souris passe dessus (zoLabel_MouseMove dans la Classe).
Ce que je ne réussi pas à faire c'est que ça s'annule quand la souris n'est plus sur le texte précédemment mis en surbrillance.
Voici le code :
Code:
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 |
Notez que c'est du VBA et non du VB6 (Important)
Je n'ai rien d'un professionnel en VBA alors soyez indulgent. C'est d'ailleurs la raison pour laquelle je cherche de l'aide :-)
