Discussion :

[DS3469]

Bonjour,

En pièce jointe un exemple du fichier qui me pose problème (le code n'est pas de moi).
Je cherche à résoudre 2 problèmes:
- 1) Lorsque l'on rentre dans un control, je souhaite que le backcolor soit Vert. Cela fonctionne pour les controls qui ne sont pas dans le multipage, mais lorsque l'on clique sur un control dans le multipage, cela ne fonctionne pas.
- 2) Lorsque l'on quitte le control, je souhaiterais que l'on revienne à la couleur d'origine du control (et non blanc comme le code le fait - là, le code fonctionne pour les controls dans multipage).
Merci de l'aide que vous pourrez m'apporter
Cordialement

[clementmarcotte]

Bonjour,

Presque personne n'ouvre les pièces jointes à la première question; surtout, surtout, surtout les fichiers qui contiennent des macros.

[DS3469]

Bonjour,

Désolé, pour la pièce jointe transmise au premier message.
Je reprend donc ma discussion au début.

Je me suis créé une petite application sans m'y connaitre au début (je ne prétend être devenu spécialiste).
Je souhaite donc réduire mon code.
Dans mon USF, j'ai plusieurs controls que je mets en "surbrillance" lorsque le control est actif.
Pour cela je les ai codé un à un,via les événement Enter et Exit.
Comme le code se répète souvent, j'ai cherché une solution pour réduire la multiplication du code.
La solution est donc de créer un module de classe (dont je commence juste à voir le fonctionnement).

J'ai trouvé le lien ci-dessous intéressant:
http://www.developpez.net/forums/d66...-combobox-usf/

Dans ce lien, on s'aperçoit que les frames peuvent poser un problème. Mais la solution a été apportée.

Puisque je cherche la difficulté, j'ai des controls dans un multipage.
Et là ça ne fonctionne pas. Dans le module, si je code pour ajouter la condition concernant le multipage:

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
Private Sub subLightActiveControlIter(ByRef ActiveObject As MSForms.Control)
Dim s As String
 
s = TypeName(ActiveObject)
If "|TextBox|ComboBox|OptionButton|CheckBox|" Like "*|" & TypeName(ActiveObject) & "|*" Then
    ActiveObject.BackColor = vbGreen
    Set ObjPre = ActiveObject
 
ElseIf TypeName(ActiveObject) = "Frame" Then
    Call subLightActiveControlIter(ActiveObject.ActiveControl)
 
ElseIf TypeName(ActiveObject) = "MultiPage" Then
    Call subLightActiveControlIter(ActiveObject.ActiveControl)
 
End If
 
End Sub

Le message d'erreur "Propriété ou méthode non gérée par cet objet" apparait.
Il semble donc que le multipage ne se comporte pas comme une frame.

J'ai donc continué mes recherches et je suis tombé sur:
http://www.developpez.net/forums/d96...urs-controles/

Comme je débute en module de classe, je n'arrive pas à adapter cette 2nde solution à la première (utilisation d'une fonction).

Comment faire pour que tous les controls soient pris en compte (y compris ceux du multipage) ?

Ma deuxieme question concerne la couleur de fond des controls à leur sortie.
En effet, si le code met en surbrillance le control à son entrée, il conviendrait qu'à la sortie du control, la couleur d'origine revienne.
Lorsque l'on code un seul control cela se fait sans problème. Cependant en passant par un module de classe, puisque les controls ont des couleurs différentes, cela ne peut se faire par un code unique définissant l'index couleur.
Cependant, je pensai que, comme chacun des controls a une couleur définie par défaut à l'ouverture du formulaire, il y aurait la possibilité de retrouver cette couleur à la sortie du control, avec quelque chose du genre backcolor.textbox = defaultcolor.
Est ce possible ?
Cordialement

[casefayere]

Bonjour,

Ma deuxieme question concerne la couleur de fond des controls à leur sortie.

pour répondre juste à cette question, regardes le fichier joint sans multipage mais qui respecte ta demande (retrouver les couleurs)

Pas terrible, ça scintille, mais bon !!

[casefayere]

après nouvel essai, sur mon fichier, tu ajoutes un "Exit For" à cette procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
For Each Ctrl In Me.Controls
  For c = 1 To UBound(Tcouleurs, 1)
    If Ctrl.Name = Tcouleurs(c, 1) Then Ctrl.Object.BackColor = Tcouleurs(c, 2): Exit For
  Next c
Next Ctrl
 
End Sub

j'ai essayé également avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

, c'est pire
EDIT : solution trouvée, "ShowModal" à False, plus de scintillement et fichier joint avec Multipage

[DS3469]

Bonjour,
Merci pour cette réponse qui fonctionne bien (pas de problèmes de scintillement).
Voila ce que j'essaie de faire:
- Si on déplace la souris, le control (textbox, optionbutton, commandbutton, combobox, checkbox) devient vert si on passe dessus et revienne à sa couleur initiale lorsque le pointeur n'est pas dessus (c'est ce que le code fait).
Une condition à cela: je souhaiterai que le control actif reste en rouge quelque soit le mouvement de la souris . Le control actif doit rester rouge tant qu'il est actif et reprendre sa couleur d'origine quand on le quitte.
- Je souhaiterais également que si dans le control actif on click sur Tab ou Enter ou Fleche Haut ou Bas, la couleur revienne à celle d'origine (puisque l'on quitte le control) et se mette en rouge dans le control dans lequel on entre.
J'ai un gros souci car je travaille avec des multipages et frames imbriquées. Si je suis dans un textbox contenu dans un multipage contenu dans un multipage, je n'arrive pas à ce qu'il se mette en rouge quand il est actif et s'il est actif et que la souris se déplace, c'est le control multipage qui se met en rouge (ce que je ne souhaite pas).
Je poursuis mes recherches, mais si on pouvait me présenter des pistes, ce serait appéciable.

[DS3469]

Bonjour,

J'avance petit à petit.
Pour éviter que ce soit la couleur du Multipage ou de la frame qui se modifie, j'ai trouvé un code qui fonctionne (avec Private Sub CouleurLastFocussedControl()) ou voir:
http://www.mrexcel.com/forum/excel-q...multipage.html

Ca fonctionne, mais je constate un truc bizarre.
Dans le fichier joint (Copie de Couleur-Controle-USF 15), si l'on se met sur les optionbutton depuis la gauche, avec la souris (pareil pour le combo dans la frame3), au plus on se décale vers la droite, la couleur passe du vert au rouge. Quelqu'un saurait pourquoi ?
J'ai également un autre souci: Ce code fonctionne si la frame est dans un multipage .
Dans mon cas, j'ai des controls (parfois dans une frame) dans un multipage qui lui même est dans un multipage (Copie de Couleur-Controle-USF 16)
L'auteur du code indique que si le multipage est imbriqué dans un autre multipage , il conviendrait de faire un whileloop. Dans ce cas,ça, je sais pas faire...
Me reste à voir, le fait de revenir à la couleur initiale du control, dès qu'on le quitte en tabulant, appuyant sur enter ou cliquant sur autre control
Merci de bien vouloir me donner les explications des codes que vous pouvez transmettre.

Merci de votre aide.

[patricktoulon]

Bonjour
si tu fait une bonne recherche dans les contributions tu trouvera ma contrib "overbutton"

quand tu entre un control dans une classe selon la méthode tu es obligé de précisé le parent du control

j'utilise une boucle for each ctrl in me.controls qui englobe tout les controls même ceux qui ne sont pas les enfants direct de l'userform
j'en ai tellement fait que même en tapant mon pseudo dans la recherche tu les retrouvera facilement et même sur ce forum

[DS3469]

Merci pour les nouvelles pistes de recherche.
J'y suis arrivé.
Je cherche maintenant à faire en sorte que le control actif soit par ex rouge et le texte en noir, lorsque l'on entre dans le control (et tant que ce control est le control actif) puis revienne à la couleur d'origine quand on le quitte (le code est fait par control, mais je pense qu'il doit y avoir moyen de regrouper cela pour ne pas avoir une répétition des lignes de codes).
En fait je souhaite trouver une astuce pour contourner l'absence des événements enter et exit dans les modules de classe.
Merci pour les pistes que vous pourrez me transmettre

[casefayere]

Bonjour le forum, Patrick

...tu passe dessus il prends une couleur et quand tu le quitte il reviens a sa couleur initial

j'ai proposé la (une) solution sur le post #5

[patricktoulon]

re
Bonjour casefayere sur ce coup la c'est un flop tu ne m'a pas habitué a cela

c'est tout simplement une torture visuelle ton truc
les caption qui disparaisse
un scintillement a rendre épileptique un mort
reste le mien comme c'est mieux

visuel de ton instrument de torture


t'avais pas déjeuné ce jour la non?

[casefayere]

eh oui, les premières fois où je l'ai testé, plus de scintillement mais tu as raison depuis (je ne sais plus ce que j'ai pu changer) les scintillements sont revenus, je testerai tes procédures sur un fichier vierge car depuis, j'ai effacé mon fichier

Bonne journée

[patricktoulon]

oh mais je sais pourquoi moi ca scintille
c'est du au fait que quand tu remet la couleur initial tu les remets tous

en fait dans une de mes multiples versions sur le forum j'avais opter pour la memo du new control actif dans un tag et me servais de ce tag pour ne remettre que celui qui avais été précédemment modifié
ainsi on a pas une mise a jour globale


purée ca pique les yeux ton machin j'ai cru que mon écran allait exploser

nan... j'rigole

[DS3469]

Bonjour à tous,

Je reviens sur ce que je souhaiterais obtenir:
Je veux que quand je passe sur un control avec la souris, il prenne une couleur et quand je le quitte il reviens a sa couleur initial, sauf pour le control actif (textbox, combobox, optionbuton) qui lui garde une couleur spécifique (par ex rouge). Ce control actif reprend sa couleur initial quand on le quitte (soit tab, enter, flche haut ou bas ou click souris sur un autre control).

J'ai trouvé le post avec le mouse in out qui est très bien.
Là je coince pour le control actif qui doit rester rouge sauf quand on le quitte (le nouveau control actif doit lui devenir rouge) et je coince aussi lorsque je tabule ou appuie sur enter pour que le control actif que l'on quitte, reprenne sa couleur initial.
Mon projet fonctionne car sur tout les controls j'ai complété les événements enter et exit un à un.
Vu la multitude de mes controls, j'ai pensé réduire mon code avec les modules de classe, mais les événements exit et enter n'existent pas pour les classes.

Cordialement.

[DS3469]

Bonjour,

Il me reste à régler le problème lorsque l'on entre dans la textbox via un clic.
J'ai trouvé le code ci-dessous:
Dans usf:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Dim txt(14) As New Classe1, i As Byte
Private Sub UserForm_Initialize()
 For i = 1 To 14: Set txt(i).txt = Me("T" & i): Next i
End Sub

Dans classe:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Public WithEvents txt As MSForms.TextBox
Private Sub txt_KeyDown(ByVal K As MSForms.ReturnInteger, ByVal Shift As Integer)
 If K = 13 Or K = 9 Or K = 40 Or K = 38 Then txt.BackColor = &H80000005
End Sub
Private Sub txt_KeyUp(ByVal K As MSForms.ReturnInteger, ByVal Shift As Integer)
 txt.BackColor = &HC0C0C0
End Sub
Private Sub txt_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
 For i = 1 To 14: User.Controls("T" & i).BackColor = &H80000005: Next i
 txt.BackColor = &HC0C0C0
End Sub

Je n'arrive pas à adapter le code concernant le "Mousedown". Je ne connais pas le nombre de textbox, je dois mettre la textbox en rouge entrant et je dois revenir à la couleur initiale en sortant de la textbox.
Pourriez vous m'aider? Ci-joint le fichier sur lequel je travaille.
Cordialement.

[DS3469]

Bonjour,

Ce fut laborieux, mais je suis arrivé à ce que je souhaitai.
Merci pour votre aide.
A toutes fins utiles ci-joint.

Cordialement

[patricktoulon]

re
Bonjour
et ben dis donc déjà que mon module overinout était une usine a gaz la t'a carrément construit une Zone industrielle

alors si tu avais chercher avec mon pseudo tu aurais trouver des versions plus récentes que celle que tu a pris dans les contributions


alors fait moi plaisir
1° sauve ton classeur sous un nom différent
2° vire tout code VBA ( je dis bien tout code)
3°ensuite met un moduleclasse que tu nommera "Over_switch_control" et met lui ceci

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
 
'                  *****************************************************************
'                  *        auteur:patricktoulon:alias chamalin1@msn.com           *
'                  *              date de creation: 14/06/2010                     *
'                  * sujet: Module classe pour donner l'effet mouseover et mouseout*
'                  *****************************************************************
'                               mise ajour  du 20/07/2016
'                                  NOUVELLE VERSION
'                            tout ce passe dans la classe!!!!!!!!!!!!!!!
'                               changement de strategie
'plus de redim preserve (moins de memoire utilisée
'plus de module standard pour memoriser encore plus de variables (memoire libérée)
'plus de boucle pour retrouver le control précédemment survolé
' Nouveau ajout de la manipulation des touches (TAB,Fleche haut,Fleche bas)
' remise en place de l'effet WOAOUH!!!!!( le bouton grossi legerement l'ors du survol)
'code simplifié
Public WithEvents bouton As MSForms.CommandButton
Public WithEvents optbouton As MSForms.OptionButton
Public WithEvents framm As MSForms.Frame
Public WithEvents formm As UserForm
Public WithEvents Multi As MSForms.MultiPage
Public WithEvents TexTo As MSForms.TextBox
Public WithEvents mem As MSForms.TextBox
Public WithEvents liste As MSForms.ListBox
Dim control(300) As New Over_switch_control
Dim uf As Object
Public wwoah As Boolean
Function initcontrol(usf, Optional woah As Boolean)
    wwoah = woah
    Set memo = usf.Controls.Add("Forms.TextBox.1", "memo")
    memo.Width = 0
    'Set control(1).formm = usf
    'Set control(1).mem = memo
    'i = 1
    For Each ctrl In usf.Controls
        i = i + 1
        'Debug.Print TypeName(ctrl)
        '*****************************on inclu dans la classe les listbox********************************
        If TypeName(ctrl) = "ListBox" Then
            ctrl.Tag = ctrl.BackColor & ":"
            i = i + 1: Set control(i).liste = ctrl
            Set control(i).mem = usf.Controls("memo"): Set control(i).formm = usf
        End If
        '***************************on inclu dans la classe les multipage pour remettre les controls d'origine  dans le move************
        If TypeName(ctrl) = "MultiPage" Then
            i = i + 1: Set control(i).Multi = ctrl
            Set control(i).mem = usf.Controls("memo"): Set control(i).formm = usf
        End If
        '*****************on inclu dans la classe les frames pour remettre les controls d'origine  dans le move*********************
        If TypeName(ctrl) = "Frame" Then
            ctrl.Tag = ctrl.BackColor & "::"
            i = i + 1: Set control(i).framm = ctrl
            Set control(i).mem = usf.Controls("memo"): Set control(i).formm = usf
        End If
        '************************************on inclu dans la classe les  textboxs****************************************
        If TypeName(ctrl) = "TextBox" Then
            ctrl.Tag = ctrl.BackColor & ":"
            i = i + 1: Set control(i).TexTo = ctrl
            Set control(i).mem = usf.Controls("memo"): Set control(i).formm = usf
        End If
        '**********************************on inclu dans la classe les commandbutton*****************************************
        If TypeName(ctrl) = "CommandButton" Then
            With ctrl
                .Tag = .BackColor & ":" & .ForeColor & ":" & .Caption & ":" & IIf(.Font.Bold, 1, 0) & ":" & IIf(.Font.Italic, 1, 0) & ":" & .Left & "," & .Top & "," & .Width & "," & .Height
            End With
            i = i + 1: Set control(i).bouton = ctrl
            Set control(i).mem = usf.Controls("memo"): Set control(i).formm = usf
        End If
        '**********************************on inclu dans la classe les  optionbuttons******************************************
        If TypeName(ctrl) = "OptionButton" Then
            With ctrl
                .Tag = .BackColor & ":" & .ForeColor & ":" & IIf(.Font.Bold, 1, 0) & ":" & IIf(.Font.Italic, 1, 0) & ":"
            End With
            i = i + 1: Set control(i).optbouton = ctrl
            Set control(i).mem = usf.Controls("memo"): Set control(i).formm = usf
        End If
    Next
End Function
Sub tabcontrol(ctrl)
    With ctrl
        .BackColor = vbRed
        .ForeColor = vbBlack
        mem.Value = ctrl.Name
    End With
End Sub
 
'*****************************evenement keyUP*****************************************************
Private Sub bouton_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If "94038" Like "*" & KeyCode & "*" Then
        remet_normal
        tabcontrol bouton
    End If
End Sub
Private Sub liste_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If "94038" Like "*" & KeyCode & "*" Then
        remet_normal
        tabcontrol liste
    End If
End Sub
 
Private Sub optbouton_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If "94038" Like "*" & KeyCode & "*" Then
        remet_normal
        tabcontrol optbouton
    End If
End Sub
 
Private Sub TexTo_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Debug.Print KeyCode
    If "94038" Like "*" & KeyCode & "*" Then
        remet_normal
        tabcontrol TexTo
    End If
End Sub
'***********************evenement mousedown******************************************************
Private Sub liste_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With liste
        .BackColor = vbRed
        .ForeColor = vbBlack
    End With
End Sub
Private Sub optbouton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With optbouton
        .BackColor = vbRed
        .ForeColor = vbBlack
    End With
End Sub
Private Sub bouton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With bouton
        .BackColor = vbRed
        .ForeColor = vbBlack
    End With
End Sub
Private Sub TexTo_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With TexTo
        .BackColor = vbRed
        .ForeColor = vbBlack
    End With
End Sub
Private Sub bouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With bouton
        If mem.Value <> bouton.Name Then
            remet_normal
            .BackColor = 16452365
            .Caption = UCase(bouton.Caption)
            .Font.Bold = True: .ForeColor = vbYellow: .Font.Italic = False
            .Move .Left - 3, .Top - 3, .Width + 6, .Height + 6    ' Effet woawh!!!!
            mem.Value = bouton.Name
        End If
    End With
End Sub
Private Sub optbouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With optbouton
        If mem <> optbouton.Name Then
            remet_normal
            .BackColor = vbGreen
            .Font.Bold = True
            .ForeColor = vbYellow
            .Font.Italic = False
            mem.Value = optbouton.Name
        End If
    End With
End Sub
 
 
Private Sub TexTo_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If mem <> TexTo.Name Then
        remet_normal
        If TexTo.BackColor = Split(TexTo.Tag, ":")(0) Then
            TexTo.BackColor = 6697881
        End If
        mem.Value = TexTo.Name
    End If
End Sub
Private Sub Liste_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If mem <> liste.Name Then
        remet_normal
        liste.BackColor = vbMagenta
        mem.Value = liste.Name
    End If
End Sub
Private Sub framm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    remet_normal
End Sub
Private Sub formm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    remet_normal
End Sub
Private Sub Multi_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    remet_normal
End Sub
Sub remet_normal()
    DoEvents
    Dim ctrl As Object
    If mem.Value <> "" Then
        Set ctrl = formm.Controls(mem.Value)
        If ctrl.Tag <> "" Then
            ctrl.BackColor = Split(ctrl.Tag, ":")(0)
            Select Case TypeName(ctrl)
            Case "CommandButton"
                dimention = Split(ctrl.Tag, ":")(5)
                dimention = Split(dimention, ",")
                With ctrl
                    .Caption = Split(ctrl.Tag, ":")(2)
                    .ForeColor = Split(ctrl.Tag, ":")(1)
                    .Font.Bold = IIf(Split(ctrl.Tag, ":")(3) = 1, True, False)
                    .Font.Italic = IIf(Split(ctrl.Tag, ":")(4) = 1, True, False)
                    .Move dimention(0), dimention(1), dimention(2), dimention(3)   ' Effet woawh exit !!!!
                End With
            Case "OptionButton"
                With ctrl
                    .ForeColor = Split(ctrl.Tag, ":")(1)
                    .Font.Bold = IIf(Split(ctrl.Tag, ":")(3) = 1, True, False)
                    .Font.Italic = IIf(Split(ctrl.Tag, ":")(4) = 1, True, False)
                End With
 
            End Select
        End If
        mem.Value = ""
    End If
End Sub

ensuite dans le module du userform met ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim cl As New Over_switch_control
 
Private Sub UserForm_Activate()
cl.initcontrol Me, True
End Sub

voila!!! maintenant lance ton userform

allez un exemplaire :

[casefayere]

purée ca pique les yeux ton machin j'ai cru que mon écran allait exploser

nan... j'rigole

oui mais si j'ouvre le fichier, c'est Noël !!!!