[Toutes versions] nouveau effet mouse in out sur les boutons dans un userform sans les apis

[patricktoulon]

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

[patricktoulon]

bonjour

apres une bonne nuit de someil on vois plus clair

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

au plaisir

[patricktoulon]

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

[patricktoulon]

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