bonjour a tous
aujourdhui je suis revenu un peu sur mon effet mouse in out mais sans les apis
le code est commenté
on instanci la classe a l'activate du userform
on decide aussi au meme moment des effet a l'appelle de l'activate du userform
couleur du fond
bold ou pas
couleur du text
effetloupe ou pas
taille de la loupe
je vous le laisse découvrir
code du userform:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 'MODULE USERFORM 'on n'utilise plus le move des controls 'le module classe va se substituer au evenement des boutons 'la classe va s'activer quand on va memoriser les couleur Private Sub UserForm_Activate() Set maform = Me memorise_couleur vbRed, True, vbWhite, True, 10 '(couleur de fond,bold,couleur du texte,efetloupe,taille de la loupe) End Sub Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) remet_normal End Sub
code pour le module de mémorisation des controls et leur propriétés
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 ' MODULE DE MEMORISATION Option Explicit Public nomcontrol As String, oldcontrol As String Public oldcouleur As Long, couleurbouton() As Long, loupe As Long Public maform As Object, effet As Boolean Public bouton() As New mesboutons 'pour instancier la classe "Mesboutons" Public couleurfont() As Long, largeur() As Long, leleft() As Long, leheight() As Long, effet_loupe As Boolean Dim ctrl As Object Public couleur_over As Variant Public fontobold As Boolean Public couleurfontover As Variant Sub memorise_couleur(coulov As Variant, fb As Variant, clfover As Variant, efloupe As Variant, lpe As Variant) 'ici les variable public sont modifié avec les ordres donné dans le activate du userform couleur_over = coulov fontobold = fb couleurfontover = clfover effet_loupe = efloupe loupe = lpe 'on boucle sur tout les controls pour memoriser les boutons et leur propriétés Dim e As Long For Each ctrl In maform.Controls On Error Resume Next If TypeName(ctrl) = "CommandButton" Then e = e + 1 'on incremente la variablee 'si le control est un bouton on memorise la couleur du fond ReDim Preserve couleurbouton(e) couleurbouton(e) = ctrl.BackColor 'si le control est un bouton on memorise la couleur du texte ReDim Preserve couleurfont(e) couleurfont(e) = ctrl.ForeColor If efloupe = True Then ReDim Preserve largeur(e) largeur(e) = ctrl.Width ReDim Preserve leleft(e) leleft(e) = ctrl.Left ReDim Preserve leheight(e) leheight(e) = ctrl.Height End If 'on memorise la collection des boutons ReDim Preserve bouton(1 To e) Set bouton(e).GroupeBouton = ctrl End If Next End Sub Sub remet_normal() Dim e As Long If oldcontrol <> "" Then 'si l'ancien controlest différent de rien 'on boucle sur tout les controls _et si c'est un commandbutton e=e+1 et on applique la couleur n°(e) precedament enregistrée For Each ctrl In maform.Controls On Error Resume Next If TypeName(ctrl) = "CommandButton" Then e = e + 1 ctrl.BackColor = couleurbouton(e) ctrl.ForeColor = couleurfont(e) ctrl.FontBold = False If effet_loupe = True Then ctrl.Width = largeur(e) ctrl.Left = leleft(e) ctrl.Height = leheight(e) End If End If oldcontrol = "" 'la variable representant l'ancien control est vidée Next End If End Sub
et enfin le module classe:il s'appelle "Mesboutons"pour subtituer les evenements des boutons pour ne pas avoir a répéter la macro a chaques boutons
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 ' ***************************************************************** ' * auteur:patricktoulon * ' * date de creation: 16/06/2011 * ' * sujet: Module classe pour donner l'effet mouseover et mouseout* ' ***************************************************************** 'nouvelle version plus simple 16/06/2011 seuls les boutons sont pris en compte 'je n'utilise plus la position en "X" et "Y" dans le boutons 'simplement le move du bouton et une variables modifiée par le nom du boutons actif 'le principe : 'si le control est différent du control précédent alors l'effet est actif 'ces trois variable sont memorise au depart dans la macro de memorisation de boutons ' couleur_over As Variant la couleur du font qui va etre appliquée ' fontobold As Boolean le bold pour le text du bouton (false ou true) ' couleurfontover As Variant couleur du texte Public WithEvents GroupeBouton As Msforms.CommandButton Private Sub GroupeBouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If GroupeBouton.Name <> oldcontrol Then 'si le bouton survolé est différent du precedent remet_normal 'au cas ou il y aurais eu un raté If effet_loupe = True Then 'on grossis un peu le bouton GroupeBouton.Width = GroupeBouton.Width + loupe GroupeBouton.Left = GroupeBouton.Left - loupe / 2 GroupeBouton.Height = GroupeBouton.Height + loupe End If GroupeBouton.BackColor = couleur_over 'on applique la couleur rouge au fond du bouton GroupeBouton.FontBold = fontobold ' on met en gras le texte du bouton GroupeBouton.ForeColor = couleurfontover 'on applique la couleur au text du bouton oldcontrol = GroupeBouton.Name 'on met la variable oldcontrol equivalante au nouveau control pour que l'effet _ soit actif sur le prochain mouvement (tout reside la)et que l'effet se face q'une seule fois quand on se ballade sur le bouton End If End Sub
au plaisir
Partager