je voudrais raccourcir le code
bonjour a tous
depuis quelques jour je m'emploie a reduire mes codes
aujourdh'ui je suis sur mon effet mouse over sur les controls dans l'userform
le tout gérer par une classe
cela dit pour chaque type de control une classecontrol est instanciée
y a t il un moyen de regrouper les control qui ont le meme type d'evenement et de propriété
exemple les commandbutton,les labels ,les checkboxs,les optionButtons ont tous un evenements click et une caption ,un backcolor,font.color,forecolor
regrouper ces controls dans la memeinstance reduirait forcement les intances de la classecontrol
seulement dans la classecontrol il y a en haut de module
Code:
1
2
3
4
5
6
7
|
Public WithEvents GroupeBouton As MSForms.CommandButton
Public WithEvents Groupeusf As MSForms.UserForm
Public WithEvents Groupelabel As MSForms.Label
Public WithEvents Groupeopt As MSForms.OptionButton
Public WithEvents Groupecheckbox As MSForms.CheckBox
Public WithEvents GroupeImage As MSForms.Image |
groupe..... representant chaque type de control
enfin bref je vous donne les codes en entier pour que vous puissiez juger
dans le userform on va mettre
Code:
1
2
3
4
|
Private Sub UserForm_Activate()
memo Me, , , True, True
End Sub |
les arguments apres me sont facultatif vous pouvez simplement mettre "memo Me"
dans un module standard on vamettre ceci:
ce module va servir a mettre chaque control dans leur instances de la classecontrol
comme vous pouvez le constater des le depart on a chaque variable tableau representant un type de control instancier une classe (c'est ce qui me gene un peu je dois dire )
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
|
Option Explicit
Public bouton() As New classe_forme 'initialisation de la classe
Public usf() As New classe_forme
Public labelo() As New classe_forme
Public optbouton() As New classe_forme
Public checko() As New classe_forme
Public stImage() As New classe_forme
Dim a, e, i, d, s, c, z
Public ctrls As Object 'variable qui va servir a memoriser tout les bouton
Public maform As Object 'variable qui va servir a memoriser l'userform
Public oldbouton As String, oldlabel As String, oldcheckbox As String, oldoptionbouton As String
Public sfontbold As Boolean, sfontItalic As Boolean
Public coulover As Variant, coultextover As Variant
Sub memo(uf As Object, Optional backcouleur As Variant = vbRed, Optional couleurtext As Variant = vbWhite, Optional ftbold As Boolean = False, Optional ftitalic As Boolean = False)
coulover = backcouleur
coultextover = couleurtext
sfontbold = ftbold
sfontItalic = ftitalic
Set maform = uf 'dorénavant maform designera l'userform dans tout le classeur
Dim e As Long
'on boucle sur tout les controls dans l'userform
For Each ctrls In uf.Controls
If TypeName(ctrls) = "CommandButton" Then
'on memorise leur couleur de base dans leur propre tag au cas ou on voudrais avoir l'effet mouse over _
appliquer dans la classe sur le move des boutons dans cet exemplaire exemple
ctrls.Tag = ctrls.BackColor & ":" & ctrls.ForeColor
If ctrls.Font.Bold = True Then ctrls.Tag = ctrls.Tag & ":oui" Else: ctrls.Tag = ctrls.Tag & ":non"
If ctrls.Font.Italic = True Then ctrls.Tag = ctrls.Tag & ":oui" Else: ctrls.Tag = ctrls.Tag & ":non"
a = a + 1
'on regroupe tout les bouton dans la classe
ReDim Preserve bouton(1 To a)
Set bouton(a).GroupeBouton = ctrls
ElseIf TypeName(ctrls) = "Label" Then
e = e + 1
'on regroupe tout les label dans la classe
ReDim Preserve labelo(1 To e)
Set labelo(e).Groupelabel = ctrls
ElseIf TypeName(ctrls) = "OptionButton" Then
i = i + 1
'on regroupe tout les OptionButton dans la classe
ReDim Preserve optbouton(1 To i)
Set optbouton(i).Groupeopt = ctrls
ElseIf TypeName(ctrls) = "CheckBox" Then
i = i + 1
'on regroupe tout les CheckBox dans la classe
ReDim Preserve checko(1 To i)
Set checko(i).Groupecheckbox = ctrls
ElseIf TypeName(ctrls) = "Image" Then
d = d + 1
'on regroupe tout les CheckBox dans la classe
ReDim Preserve stImage(1 To d)
Set stImage(d).GroupeImage = ctrls
End If
Next
ReDim Preserve usf(1)
Set usf(1).Groupeusf = uf
End Sub |
maintenant la classecontrol
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
|
Public WithEvents GroupeBouton As MSForms.CommandButton
Public WithEvents Groupeusf As MSForms.UserForm
Public WithEvents Groupelabel As MSForms.Label
Public WithEvents Groupeopt As MSForms.OptionButton
Public WithEvents Groupecheckbox As MSForms.CheckBox
Public WithEvents GroupeImage As MSForms.Image
Dim truc As OLEObjects
'EVENEMENT MouseMove DE TOUS LES BOUTONS
Public Sub GroupeBouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If oldbouton <> "" Then remet_oldcontrol_normal
If GroupeBouton.BackColor <> vbRed Then
GroupeBouton.BackColor = coulover: GroupeBouton.ForeColor = coultextover: GroupeBouton.Font.Bold = sfontbold: GroupeBouton.Font.Italic = sfontItalic
oldbouton = GroupeBouton.Name
End If
End Sub
'EVENEMENT Mousemove DE L USERFORM
Private Sub Groupeusf_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' si un bouton a été survolé oldbouton n'est plus vide alors
If oldbouton <> "" Then remet_oldcontrol_normal
End Sub
'EVENEMENT Click DE TOUS LES LABELS
Private Sub Groupelabel_Click()
MsgBox "coucou je suis un " & TypeName(Groupelabel) & vbCrLf & "mon nom est " & Groupelabel.Name
End Sub
'EVENEMENT Click DE TOUS LES OPTIONBOUTON
Private Sub Groupeopt_Click()
MsgBox "coucou je suis un " & TypeName(Groupeopt) & vbCrLf & "mon nom est " & Groupeopt.Name
End Sub
'EVENEMENT Click DE TOUS LES CHECKBOXS
Private Sub Groupecheckbox_Click()
MsgBox "coucou je suis un " & TypeName(Groupecheckbox) & vbCrLf & "mon nom est " & Groupecheckbox.Name
End Sub
'EVENEMENT Click DE TOUtes LES Images
Private Sub GroupeImage_Click()
MsgBox "coucou je suis un " & TypeName(GroupeImage) & vbCrLf & "mon nom est " & GroupeImage.Name
End Sub
'REMET LE DERNIER BOUTON SURVOLE A SON ETAT INITIALen utilisant la variables "oldcontrol" qui contient le nom du dernier bouton survolé
Sub remet_oldcontrol_normal()
maform.Controls(oldbouton).BackColor = Split(maform.Controls(oldbouton).Tag, ":")(0)
maform.Controls(oldbouton).ForeColor = Split(maform.Controls(oldbouton).Tag, ":")(1)
If Split(maform.Controls(oldbouton).Tag, ":")(2) = "non" Then maform.Controls(oldbouton).Font.Bold = False
If Split(maform.Controls(oldbouton).Tag, ":")(3) = "non" Then maform.Controls(oldbouton).Font.Italic = False
End Sub |
voila alors y a t il un moyen de reduire ce code
merci pour le retour au plaisir
