Nouveau effet mouse in out sur les boutons dans un userform sans les apis

Version imprimable

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:

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:

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:

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

bonjour

apres une bonne nuit de someil on vois plus clair :mouarf::mouarf:

voici la nouvelle version

nouveauté!!!!:
on aplus besoins de marquer quoi que se soit dans l'evenement userfom mouse move

on peu choisir l'effet loupe ou pas
le pourcentage de la loupe
on peut choisir la couleur de l'effet sur le fond et le texte des 4 facons
diférentes
format "ex"
format "long"
format "index" de 1 a 56
format RGB
module du userfom:
ici je l'ai mis dans le activate mais on peut le metre dans un evenement d'un control par exemple

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
 
'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 en utilisant le module memorisation
Private Sub UserForm_Activate()
 
    memorise_couleur Me, RGB(100, 146, 123), True, vbCyan, True, 5, True
   'les variable corespondent à(couleur de fond si bouton survolé,en gras ou pas,couleur du texte si bouton survolé,efetloupe si bouton survolé ,taille de la loupe,effet maguscule si bouton survolé)
 
End Sub
 
'LES VARIABLE 'COULOVER' ET 'CLFOVER' PEUVENT ETRE DONN2ES DE DIFFERENCE FACONS
'**********************************************
'en "RGB(x,x,x)"
'EXEMPLE:
'RGB(100, 146, 123)
'**********************************************
'OU EN LETTRE
'EXEMPLE:
'vbred(rouge),vbYellow (jaune),vbblue(bleu),vbblack(noir),vbMagenta,vbCyan(bleucyan),ect.....
'**********************************************
'ou en valeur "long" (entre 0 et 16777215)
'EXEMPLE:
'123654
'**********************************************
'ou en valeur "ex"
'EXEMPLE:
'&HF378E0
'************************************************
'ou les couleur indexée de l'application excel( de 1 a 56)
'EXEMPLE:
'ActiveWorkbook.Colors(3)(qui donne la couleur rouge)
'***************************************************
 
'on trouve a divers endroit du site les corespondance couleurs
'notament ici
'http://silkyroad.developpez.com/VBA/ConversionCodesCouleurs/#LII
'*******************************************************************************************************
'*******************************************************************************************************
'LA VARIABLE "lpe"(loupe) représente le pourcentage qui sera appliqué sur la base de la taille du bouton
'exemple:
'si lpe = 5
'lebouton.width=lebouton.width+((lebouton.width/100)*lpe)

voici le module de memorisation des données

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
87
88
 
'                                  MODULE DE MEMORISATION
 
 
Option Explicit
 
 
 
Public oldcontrol As String
Public couleurbouton() As Long, loupe As Long
Public maform As Object
Public bouton() As New EFFET_MOUSE_IN_OUT     'pour instancier la classe pour les boutons
Public monusf() As New EFFET_MOUSE_IN_OUT          ' pour l'userform
Public couleurfont() As Long, largeur() As Long, leleft() As Long, leheight() As Long, letop() As Long, effet_loupe As Boolean
Dim ctrl As Object
Public couleur_over As Variant
Public fontobold As Boolean
Public couleurfontover As Variant
Public mage As Boolean
Sub memorise_couleur(usf As Object, coulov As Variant, fb As Variant, clfover As Variant, efloupe As Variant, lpe As Variant, mge As Boolean)
 
    Set maform = usf
    'ici les variable public sont modifié avec les valeurs donné dans le activate du userform
    couleur_over = coulov
    fontobold = fb
    couleurfontover = clfover
    effet_loupe = efloupe
    mage = mge
    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
            'on memorise les coordonnées du bouton si l'effet loupe est actif(pour eviter de memoriser si ca n'est pas necessaire)
            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
                ReDim Preserve letop(e)
                letop(e) = ctrl.Top
            End If
            'on memorise la collection des boutons
            ReDim Preserve bouton(1 To e)
            Set bouton(e).GroupeBouton = ctrl
        End If
    Next
    'on insere le userform lui meme dans la collection(laclasse)
    ReDim Preserve monusf(1)
    Set monusf(1).monform = maform
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
 
            ' si le type du control est "commandbutton"on remet tout a l'initial par les variable memorisé a l'activate du form
            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)
                    ctrl.Top = letop(e)
                    If mage = True Then ctrl.Caption = LCase(ctrl.Caption)
                End If
            End If
            oldcontrol = ""    'la variable representant l'ancien control est vidée
        Next
    End If
End Sub

et voici enfin le module classe qui se nome EFFET_MOUSE_IN_OUT

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
 
 
'                  *****************************************************************
'                  *                   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
'Ce module classe se subtitue au evenement des controls et de leur userform
 
'je n'utilise plus la position en "X" et "Y" dans le boutons bien trop aléatoire et moins precis
'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  variables sont décidées memorisées 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
'   effetloupe                             (true ou false)
'   taille de la loupe                     ( valeur en chifre)
 
 
Public WithEvents GroupeBouton As Msforms.CommandButton
Public WithEvents monform As Msforms.UserForm
'evenement du bouton
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é(déplacement de souris trop rapide)
 
 
        GroupeBouton.BackColor = couleur_over
 
        GroupeBouton.FontBold = fontobold    ' on met en gras le texte du bouton
        GroupeBouton.ForeColor = couleurfontover
 
        If effet_loupe = True Then
            'on grossis un peu le bouton
            If mage = True Then
                GroupeBouton.Width = GroupeBouton.Width + ((GroupeBouton.Width / 100) * loupe) + 9    '(pour eviter d'avoir le texte de la caption coupé)
 
            Else
                GroupeBouton.Width = GroupeBouton.Width + (GroupeBouton.Width / 100) * loupe
            End If
            GroupeBouton.Left = GroupeBouton.Left - loupe / 2
            GroupeBouton.Height = GroupeBouton.Height + loupe
            GroupeBouton.Top = GroupeBouton.Top - loupe / 2
 
        End If
 
        If mage = True Then
            GroupeBouton.Caption = UCase(GroupeBouton.Caption)
        End If
        '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
'evenement de l'userform
Private Sub monform_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    remet_normal
End Sub
Private Sub monform_QueryClose(Cancel As Integer, CloseMode As Integer)
'on ferme la classe
    Set bouton() = Nothing
    Set monusf() = Nothing
End Sub

voila

si vous avez des suggestions je ne suis pas contre:ccool:

au plaisir

nouvelle version

bonjour a tous

depuis le début j'essaie de réduire le code ce que j'avais relativement bien réussi

après une suggestion de qwazerty sur une autre question il m'est venu une idée

après les réduction de code successives pourquoi ne pas réduire aussi l'utilisation de la mémoire

en effet

pour que l'effet soit actif j'utilisais au début
la fonction "redim preserve"pour mémoriser les bouton et leur propriétés
ce qui avait pour effet d'avoir X variables multipliées par le nombre de bouton dans le userform

aujourd'hui on va utiliser la propriété ".tag"pour mémoriser les propriétés des bouton ainsi que les effet voulu
les effets voulus seront déterminés a l'activa te de l'userform de façon a
pouvoir utiliser la même macro et le même module classe pour plusieurs userform dans le même fichier

avec les anciennes version lors de l'appel a la macro pour remettre le bouton a son état initial je bouclais sur tout les boutons pour les remettre tous a l'état initial ce qui avais pour conséquence de boucler (X fois-1) de trop
ce qui avait pour effet et un effet désagréable de scintillement avec des ordinateurs un peu moins puissants

le principe du nouveau modèle:

a l'activa te d'un userform on appelle la macro "mémo" suivi des effets que l'on souhaite avoir lors du survol de la souris sur le boutons

la macro "memo "
alimente le tag de chaque bouton de leurs propriété ainsi que les effets voulu
elle collectionne tout les boutons dans la classe pour gérer les évènements des boutons

la macro "remet normal"
celle ci sert a remettre le bouton précédent a l'initial en utilisant les données du tag découpé avec la fonction split pour séparer tout les propriétés dans un tableau

ensuite chaque tableau(X) correspondent a chaque propriétés

et on applique les propriétés sur le bouton

dans le module classe sur l'événement mouse move on pratiquer de la même manier qu'avec la macro "remet normal"
on utilise le tag splittés dans un tableau pour récupérer les effets
ensuite on les appliques

voila bon assez de blabla voici le code:
dans le module userform:
Code:

1 2 3 4 5 6 7 8 Private Sub UserForm_Activate() memo Me, vbRed, True, True, vbBlack, True, True 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
maintenant dans un module standard:
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 Option Explicit Public ctrl As String 'variable qui va servir a enregistrer le nom du control sur la quelle la souris passe Public bouton() As New EFFET_waow 'initialisation de la classe Public ctrls As Variant 'variable qui va servir a memoriser tout les bouton Public maform As Object 'variable qui va servir a memoriser l'userform Public propriétés As Variant 'variable de type tableau pour manipuler les propriete avec le tag renseigne parles propriétés Sub memo(uf As Object, couleurboutonsurvolé As Long, effetloupe As Boolean, text_en_gras As Boolean, _ couleur_texte_bouton_survolé As Long, grossissement_du_texte As Boolean, mettre_le_texte_en_majuscule As Boolean) 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 'on teste si le type de control est un bouton If TypeName(ctrls) = "CommandButton" Then 'on va memoriser toutes les propriétés de depart des boutons ainsi que les effet directement dans leurs tags(nouveau principe!!!!) ctrls.Tag = ctrls.BackColor & ":" & ctrls.ForeColor & ":" & ctrls.Left & ":" & ctrls.Width & ":" & ctrls.Top & ":" & _ ctrls.Height & ":" & couleurboutonsurvolé & ":" & effetloupe & ":" & text_en_gras & ":" & couleur_texte_bouton_survolé _ & ":" & grossissement_du_texte & ":" & mettre_le_texte_en_majuscule & ":" & ctrls.Font.Size ctrl = ctrls.Name e = e + 1 'on incremente la variablee 'on regroupe tout les bouton dans la classe ReDim Preserve bouton(1 To e) Set bouton(e).GroupeBouton = ctrls End If Next End Sub Sub remet_normal() With maform.Controls(ctrl) 'on decoupe la chaine de caractere que constitu le tag pour separer chaques propriétés propriétés = Split(.Tag, ":") .BackColor = propriétés(0) .ForeColor = propriétés(1) .Caption = LCase(.Caption) .FontBold = False .Font.Size = propriétés(12) If propriétés(7) = True Then .Width = propriétés(3) .Left = propriétés(2) .Height = Val(propriétés(5)) .Top = Val(propriétés(4)) End If End With End Sub
maintanant dans un module classe que vous allez nomer"EFFET_waow"placons le code qui suit:
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 Public WithEvents GroupeBouton As MSForms.CommandButton Public Sub GroupeBouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim propri As Variant ' maintenant au passage de la souris si la variable ctrl contenant la propriété du bouton precedant _ est différente de celles du bouton actuel If ctrl <> GroupeBouton.Name Then 'on appelle la macro "remet_normal" pour remettre le bouton precedant a l'origine remet_normal 'on memorise maintenant le nouveau nom du bouton(bouton actuel) ctrl = GroupeBouton.Name End If 'on affecte le tagdu bouton actuel au tableau(propri) propri = Split(GroupeBouton.Tag, ":") 'on applique les effets qui ont été determinés l'ors e l'appel a la macro _ "memo(........)dans le activate du userform et qui ont été enregistrées dans le tag" With GroupeBouton .BackColor = Val(propri(6)) .ForeColor = Val(propri(9)) .FontBold = propri(8) If propri(7) = True Then 'si l'effet loupe est a true .Width = Val(propri(3) + 10) .Left = Val(propri(2) - 5) .Height = Val(propri(5) + 10) .Top = Val(propri(4) - 5) End If If propri(11) = True Then .Caption = UCase(GroupeBouton.Caption) If propri(10) = True Then .Font.Size = propri(12) + 1 'on ajoute 2 taille au font size End With End Sub Public Sub GroupeBouton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) GroupeBouton.BackColor = vbYellow GroupeBouton.ForeColor = vbBlue End Sub
voila le code est relativement bien commenté

l'avantage de cette nouvelle version c'est que malgré le nombre bien inferieur de variables utilisées on retrouve un effet individuel sur chaques boutons
c'est a dire qu'avec le dernier model il fallait que les boutons aient les memes propriétés sur leur captions
tandis que maintenant chaques boutons peuvent etre absolument différents en tout point

je vous laisse le soin de juger
si vous avez des suggestions n'hésitait pas je suis preneur
au plaisir

re:amelioration

bonjour a tous

voila dans un autre projet mercatog ma aiguillé sur la fonction "optional des arguments dans une fonction ou sub

et bien je me suis servi de ca et remis a niveau mon effet mouse
nous avons donc maintenant tout les arguments apres "memo me" facultatifs

sachez que les argument type boolean sont a false par defaut si il sont omis

et les couleurs de fond et texte du bouton pour le mouse over sont a rouge et blanc et inversement pour le mouse down par defaut

voila le code :

dans le userform

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'nouvelle mise a jour le:21/04/2012
'Tous les arguments sont optional(facultatifs)
'si les arguments sont omis la couleur de fond est blanc l'ors du survol ,la couleur de la caption est rouge _
et inversement quand on appuie sur le bouton
 
'les couleur sur le mouse down est maintenant géré aussi
Private Sub UserForm_Activate()
 memo Me, vbGreen, True, True, vbBlue, True, True, vbRed, vbYellow
 
'memo Me             'juste l'effet par deffaut (bouton survolé: couleur de fond rouge par defaut  et font colorblanc par defaut::: bouton apuyé: couleur de fond blanc par defaut  et font color rouge par defaut)
 
'memo Me, vbGreen    'la couleur de fond change en vert au passage de la souriset reviens a l'initial a la sortie du bouton
 
' ect.....           'enfin comme vous l'avez compris tous les arguments sont facultatif dans l'apel "memo me"
End Sub
'Merci a mercatog pour m'avoir aiguiller sur la possibilité de rendres les arguments "OPTIONAL"(facultatif) avec valeur par default

dans le module standard

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
Option Explicit
Public ctrl As String    'variable qui va servir a enregistrer le nom du control sur la quelle la souris passe
Public bouton() As New EFFET_waow    'initialisation de la classe
Public usf() As New EFFET_waow    'initialisation de la classe
 
Public ctrls As Variant    'variable qui va servir a memoriser tout les bouton
Public maform As Object    'variable qui va servir a memoriser l'userform
Public propriétés As Variant   'variable de type tableau pour manipuler les propriete avec le tag renseigne parles propriétés
 
Sub memo(uf As Object, Optional couleurboutonsurvolé As Variant = vbRed, Optional effetloupe As Boolean = False, Optional text_en_gras As Boolean = False, _
         Optional couleur_texte_bouton_survolé As Variant = vbWhite, Optional grossissement_du_texte As Boolean = False, Optional mettre_le_texte_en_majuscule As Boolean = False, Optional couleur_bouton_appuyé As Variant = vbWhite, Optional couleur_texte_bouton_appuyé As Variant = vbRed)
    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
        'on teste si le type de control est un bouton
        If TypeName(ctrls) = "CommandButton" Then
            'on va memoriser toutes les propriétés de depart  des boutons ainsi que les effet directement dans leurs tags(nouveau principe!!!!)
            ctrls.Tag = ctrls.BackColor & ":" & ctrls.ForeColor & ":" & ctrls.Left & ":" & ctrls.Width & ":" & ctrls.Top & ":" & _
                        ctrls.Height & ":" & couleurboutonsurvolé & ":" & effetloupe & ":" & text_en_gras & ":" & couleur_texte_bouton_survolé _
                      & ":" & grossissement_du_texte & ":" & mettre_le_texte_en_majuscule & ":" & ctrls.Font.Size & ":" & couleur_bouton_appuyé & ":" & couleur_texte_bouton_appuyé
            ctrl = ctrls.Name
            e = e + 1    'on incremente la variablee
            'on regroupe tout les bouton dans la classe
            ReDim Preserve bouton(1 To e)
            Set bouton(e).GroupeBouton = ctrls
        End If
    Next
ReDim Preserve usf(1)
            Set usf(1).Groupeusf = uf
 
 
End Sub
Sub remet_normal()
    With maform.Controls(ctrl)
        'on decoupe la chaine de caractere que constitu le tag pour separer chaques propriétés
        propriétés = Split(.Tag, ":")
        .BackColor = propriétés(0)
        .ForeColor = propriétés(1)
        .Caption = LCase(.Caption)
        .FontBold = False
        .Font.Size = propriétés(12)
        If propriétés(7) = True Then
            .Width = propriétés(3)
            .Left = propriétés(2)
            .Height = Val(propriétés(5))
            .Top = Val(propriétés(4))
        End If
    End With
End Sub

et maintenant la classe

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
Public WithEvents GroupeBouton As MSForms.CommandButton
Public WithEvents Groupeusf As MSForms.UserForm
 
Public Sub GroupeBouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim propri As Variant
    ' maintenant au passage de la souris si la variable ctrl contenant la propriété du bouton precedant _
      est différente de celles du bouton actuel
    If ctrl <> GroupeBouton.Name Then
        'on appelle la macro "remet_normal" pour remettre le bouton precedant a l'origine
        remet_normal
        'on memorise maintenant  le nouveau nom du bouton(bouton actuel)
        ctrl = GroupeBouton.Name
    End If
    'on affecte le tagdu bouton actuel  au tableau(propri)
    propri = Split(GroupeBouton.Tag, ":")
    'on applique les effets  qui ont été determinés l'ors e l'appel a la macro _
    "memo(........)dans le activate du userform et qui ont été enregistrées dans le tag"
    With GroupeBouton
        .BackColor = Val(propri(6))
        .ForeColor = Val(propri(9))
        .FontBold = propri(8)
        If propri(7) = True Then    'si l'effet loupe est a true
            .Width = Val(propri(3) + 30)
            .Left = Val(propri(2) - 15)
            .Height = Val(propri(5) + 10)
            .Top = Val(propri(4) - 5)
        End If
        If propri(11) = True Then .Caption = UCase(GroupeBouton.Caption)
        If propri(10) = True Then .Font.Size = propri(12) + 1    'on ajoute 2 taille au font size
    End With
End Sub
Public Sub GroupeBouton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    propri = Split(GroupeBouton.Tag, ":")
    GroupeBouton.BackColor = propri(13)
    GroupeBouton.ForeColor = propri(14)
End Sub
Public Sub Groupeusf_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
remet_normal
End Sub

voila au plaisir

15/03/2013, 11h05
le-guedin

Super patricktoulon :ccool:

Je viens de tester et c'est top !!
05/12/2015, 18h35
CaptainMeta
Bonjour patricktoulon,

Je suis en train d'essayer d'appliquer ton code à un de mes usf. Seulement j'ai un problème si le bouton est dans un frame :

- en passant sur le bouton la couleur change --> parfait! :D
- en sortant du bouton la couleur reste identique. Il faut sortir du frame ou passer sur un autre bouton pour que le bouton retrouve sa mise en forme précédente.. --> pb :/

J'ai essayé de comprendre le code mais j'avoue qu'il y a encore des parties mystiques pour moi ^^ Je dirai que le problème vient de cette partie :
Code:

1 2 3 Public Sub Groupeusf_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) remet_normal End Sub
Mais je n'en suis pas sûr et je ne vois pas comment la modifier..

As tu déjà eu ce problème? As tu une idée pour éviter ça?

Merci d'avance (et surtout merci pour le code actuel! :) )

Bonne soirée

Captain

PS : Désolé du déterrage..
06/12/2015, 20h05
patricktoulon

re

Bonjour

et oui c'est evident

le retour a la couleur initial si je me rapelle bien est fait en passant sur un autre bouton ou sur un endroit vide du userform forcement si tu a qu'un bouton dans la frame il faut ajouter la frame dans la classe ainsi que son evenement mosemove de la meme maniere que je le fait pour le userform

mais depuis j'ai largement simplifier les classe je n'ai plus besoins de module standard je te fait un exemple des que j'ai un moment

re voila une classe over yper simple

re
bon voila comme ca vite fait en reprenant l'idée qui commence effectivement a dater

ajoute un module classe dans ton projet
nomme ce module classe "overbouton"
et colle lui ceci: a l'interieur :

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
Public WithEvents bouton As MSForms.CommandButton
Public WithEvents framm As MSForms.Frame
Public WithEvents formm As UserForm
Dim BTN(100) As New overbouton
Dim fram(100) As New overbouton
Dim form(1) As New overbouton
Function initbouton(usf)
    Set form(1).formm = usf
    For Each ctrl In usf.Controls
        If TypeName(ctrl) = "CommandButton" Then
            ctrl.Tag = ctrl.BackColor
            i = i + 1: Set BTN(i).bouton = ctrl
        End If
        If TypeName(ctrl) = "Frame" Then
            f = f + 1: Set fram(f).framm = ctrl
        End If
    Next
End Function
Private Sub bouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If bouton.BackColor = bouton.Tag Then bouton.BackColor = vbRed
End Sub
Private Sub framm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Set usf = framm.Parent
    For Each ctrl In usf.Controls
        If TypeName(ctrl) = "CommandButton" Then ctrl.BackColor = ctrl.Tag
    Next
End Sub
Private Sub formm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    For Each ctrl In formm.Controls
        If TypeName(ctrl) = "CommandButton" Then ctrl.BackColor = ctrl.Tag
    Next
End Sub

maintenant dans ton userform met lui en haut de module (je dis bien en haut de module pas dans un private sub....

Code:

Dim cl As New overbouton

et dans le activate du userform se sera :

Code:

1
2
3
Private Sub UserForm_Activate()
cl.initbouton Me
End Sub

resultat a chaque fois que tu survolera un bouton dans ton userform il devient rouge et revient a sa couleur initiale des que tu le quitte et que tu survole la frame ou le userform

ca fonctionne avec les boutons dans la frame ou dans userform sans distinction

au plaisir
ca donne un petit coup de jeune a la contribution
merci il etait temps ;)

31/12/2015, 08h15
antonysansh

Coucou patricktoulon :coucou:

La dernière version est impressionnante de simplicité et d'efficacité. J'adore ! :plusser:

Je compte m'inspirer de ton code pour certain de mes formulaires.
Avec pourquoi pas plusieurs propriétés dans le tag.

J'ai juste une petite question. A quoi servent les tableaux BTN, fram et form ? C'est juste pour transformer les Controls en Objet bouton, framm ou formm de la classe overbouton, pour ensuite utiliser les Events associés ?

Un exemple pour gérer 3 propriétés (couleur de fond, couleur du texte, gras du texte) :

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
Option Explicit
 
Public WithEvents bouton As MSForms.CommandButton
Public WithEvents framm As MSForms.Frame
Public WithEvents formm As UserForm
 
Dim BTN(100) As New overbouton
Dim fram(100) As New overbouton
Dim form(1) As New overbouton
 
Public Enum ePropriete
    CouleurFond
    CouleurText
    Gras
End Enum
 
Function initbouton(usf)
    Dim ctrl As Control, b&, f&
    Set form(1).formm = usf
    For Each ctrl In usf.Controls
        If TypeName(ctrl) = "CommandButton" Then
            ctrl.Tag = ctrl.BackColor & "//" & ctrl.ForeColor & "//" & ctrl.FontBold
            b = b + 1: Set BTN(b).bouton = ctrl
        End If
        If TypeName(ctrl) = "Frame" Then
            f = f + 1: Set fram(f).framm = ctrl
        End If
    Next
End Function
 
Private Sub bouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With bouton
        If .BackColor & "//" & .ForeColor & "//" & .FontBold = .Tag Then
            .BackColor = vbRed
            .ForeColor = vbWhite
            .FontBold = True
        End If
    End With
End Sub
 
Private Sub framm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim ctrl As Control, t$()
    Set usf = framm.Parent
    For Each ctrl In usf.Controls
        If TypeName(ctrl) = "CommandButton" Then
            With ctrl
                t = Split(.Tag, "//")
                .BackColor = t(ePropriete.CouleurFond)
                .ForeColor = t(ePropriete.CouleurText)
                .FontBold = t(ePropriete.Gras) = "VRAI"
            End With
        End If
    Next
End Sub
 
Private Sub formm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim ctrl As Control, t$()
    For Each ctrl In formm.Controls
        If TypeName(ctrl) = "CommandButton" Then
            With ctrl
                t = Split(.Tag, "//")
                .BackColor = t(ePropriete.CouleurFond)
                .ForeColor = t(ePropriete.CouleurText)
                .FontBold = t(ePropriete.Gras) = "VRAI"
            End With
        End If
    Next
End Sub

Le t(ePropriete.Gras) = "VRAI" doit vous s'embler bizarre.
En fait ctrl.Tag = ctrl.BackColor & "//" & ctrl.ForeColor & "//" & ctrl.FontBold va mettre "X//Y//Z" dans la propriété .Tag et Z ne peut être que "VRAI" ou "FAUX".
Comme on ne peut mettre que True ou False dans la propriété .FontBold, Z = "VRAI" va bien répondre True si Z = "VRAI" et False sinon.

31/12/2015, 09h08
patricktoulon

Re

Re bonjour
Oui
C'eSt ca en fait on instantie une classe pour chaque contrôle et oui les ancienne version memorisaient plusieur paramettres dans le tag regarde bien les anciennes versions
31/12/2015, 15h59
patricktoulon

re

bonjour
antonislash regarde ce POST JE SUIS ALLe BIEN PLUS LOIN JE PROPOSE MEME L'EFFET WOAOW!!! mais ca date un peu entre nous
21/02/2018, 23h31
omrsmiloud

merci patricktoulon
je viens trop tard mais ...
la dernier fonctionne très bien , sauf si les boutons sont lié l'un a coté de l'autre ,sans espace , ( bouton adjacent) sa ne donne pas l'effet désiré, en passant d'un bouton a l'autre , les deux , voir plus, reste en rouge ( je l'ai utilisé pour un calendrier )
en tous cas merci
21/02/2018, 23h46
patricktoulon

re

bonsoir
quelle version a tu utilisé car depuis il y en a eu un paquet et ce que je me souvienne meme collé les boutons ca fonctionne
tout depend de tes besoins prendre une version ou l autre
22/02/2018, 14h29
omrsmiloud

bonjour
tous d'abord merci de m'avoir répondu
je parle de ta version du 6/12/2015, j'ai due modifié la disposition des boutons , ça marche nickel

Dans la foulée , est ce que ces effets consomment de la mémoire RAM en arrière plan ? je ne veut pas que sa tombe en détriment de la rapidité du programme qui peut être installé dans des postes plus ou moins "rapides"

Bien cordialement
22/02/2018, 23h25
patricktoulon

re

sur ce model je n'ai pas entendu parler de probleme de memoire
c'est un effet qui a lieu a l'entrer du bouton et a sa sortie dans l'interval il se passe rien normalement
c'est le but de la manoeuvre
pour les bouton collé je vais verifier je crois que tu a pris la version simplifié qui en est depourvu

1 pièce(s) jointe(s)

re pour les boutons collés

re
@omrsmiloud

pour tes boutons collés

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
Public WithEvents bouton As MSForms.CommandButton
Public WithEvents framm As MSForms.Frame
Public WithEvents formm As UserForm
Dim BTN(100) As New overbouton
Dim fram(100) As New overbouton
Dim form(1) As New overbouton
Public uff As Object
Function initbouton(usf)
    Set form(1).formm = usf: Set form(1).uff = usf
    For Each ctrl In usf.Controls
        If TypeName(ctrl) = "CommandButton" Then
            ctrl.Tag = ctrl.BackColor
            i = i + 1: Set BTN(i).bouton = ctrl: Set BTN(i).uff = usf
        End If
        If TypeName(ctrl) = "Frame" Then
            f = f + 1: Set fram(f).framm = ctrl: Set fram(f).uff = usf
        End If
    Next
End Function
Private Sub bouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If bouton.BackColor = bouton.Tag Then bouton.BackColor = vbRed
 If uff.Tag <> "" And uff.Tag <> bouton.Name Then uff.Controls(uff.Tag).BackColor = uff.Controls(uff.Tag).Tag
  uff.Tag = bouton.Name
End Sub
Private Sub framm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If uff.Tag <> "" And uff.Tag <> bouton.Name Then uff.Controls(uff.Tag).BackColor = uff.Controls(uff.Tag).Tag
End Sub
Private Sub formm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If uff.Tag <> "" Then uff.Controls(uff.Tag).BackColor = uff.Controls(uff.Tag).Tag
End Sub

Pièce jointe 353841

au plaisir;)

27/02/2018, 22h28
omrsmiloud

bonsoir
désolé du retard , je vais essayer de l'adapter a mon programme
merci bien patrick