[Toutes versions] fonction mouse over et mouse out pour les boutons de vos userforms

[patricktoulon]

bonsoir a tous

je redepose mon userform avec l'effet mouse over et mouse out parfaitement fonctionnel

fonction qui est absente en vba

le principe:
une sub memorise les propriétés des boutons(couleur de fond,couleur du text,
fontsize,bold ,italic )

la classe est initialisé

et dans le module classe au survol de la souris les couleur du fond et de la caption du bouton s'inversent le texte deviens en majuscule et italic
l'orsque on quitte le bouton il redeviens comme avant




au plaisir

[Philippe JOCHMANS]

Bonjour

Il faudrait que tu donnes plus de détails sur le code que tu utilises, et comment cela fonctionne.

En effet, les membres du forum qui voudront adapter ta contribution auront du mal s'ils ne comprennent pas ce que tu as fais.

Philippe

[patricktoulon]

bonjour philippe jochmans
excuse moi de ne pas avoir répondu plutôt mais j'ai eu beaucoup de boulot

d'accord je vais essayer d'en expliquer le fonctionnement

tout d'abord dans un module standard
on va déclarer les variables nécessaire



et avec une boucle sur les contrôles nous allons mémoriser les propriétés des bouton (couleur de fond ,couleur de la captions , et inversion des deux


avec la fonction "redim preserve" et en public pour les avoir a dispo dans tout le fichier et a n'importe quel moment

ainsi que le module class



comme ce 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 bouton() As New Mesboutons'on declare la nouvelle class
'ici les variables globales avec les deux parenthezes car ca sera une serie
Public couleurbouton(), couleurtext(), newcouleurbouton(), newcouleurtext(), e, a As Long 'deux variables pour incrementer la serie de boutons 
 
Public nombouton As String
'Dim ctrl As Control
 
Sub memorise_couleur(maform)
a = 0
For Each ctrl In maform.Controls
On Error Resume Next
If TypeName(ctrl) = "CommandButton" Then
If IsNumeric(Right(ctrl.Name, 2)) Then
e = Right(ctrl.Name, 2)
Else
e = Right(ctrl.Name, 1)
End If
 
ReDim Preserve couleurbouton(e)
couleurbouton(e) = ctrl.BackColor
ReDim Preserve couleurtext(e)
couleurtext(e) = ctrl.ForeColor
ReDim Preserve newcouleurbouton(e)
newcouleurbouton(e) = ctrl.ForeColor
ReDim Preserve newcouleurtext(e)
newcouleurtext(e) = ctrl.BackColor
End If
a = a + 1
 
'memorisation de la collection de bouton
ReDim Preserve bouton(1 To a)
Set bouton(a).GroupeBouton = ctrl
Next
End Sub

on va aussi enregistrer la collection de bouton du premier jusqu'au dernier


en suite on fait une petite macro pour les remettre a l'initial a la demande
comme ce qui suit
toujours pareil en bouclant sur les contrôles en éliminant tout ce qui n'est pas un commandbutton

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub initial(form)
e = 1
For Each ctrl In form.Controls
On Error Resume Next
If TypeName(ctrl) = "CommandButton" Then
ctrl.BackColor = couleurbouton(e)
ctrl.ForeColor = couleurtext(e)
ctrl.FontBold = False
ctrl.Font.Italic = False
ctrl.Caption = LCase(ctrl.Caption) 'met en minuscule le text de la caption
 
e = e + 1
End If
Next
End Sub

ensuite dans le userform a l'activate on appelle la macro précédemment citée
"memorise couleur suivi de l'object "me" sa evite le besoins de determinr le nom de l'userform ainsi aussi on peut l'utiliser sur nimporte quel userform sans le nommer explicitement

Code :

1
2
3
4
Private Sub UserForm_Activate()
'on appelle la routine qui va memoriser les propriété  des boutons
memorise_couleur Me
End Sub

ensuite comme la class est déclaré en debut de module standard


avec ceci:qui va capter les evenement de groupebouton se substituant au bouton eux memes

Code :

Public WithEvents GroupeBouton As Msforms.CommandButton

et dans le moduleclass on a des macros tres resemblantes a celles des evenement dans l'userform lui meme
comme ci

Code :

1
2
:
"private sub Groupebouton"

se substitue par exemple a :

Code :

1
2
 
 private sub commandbutton1"

ainsi on va derminer la valeur de "i" selon le chiffre dans le nom du bouton
ce chiffre correspondra au chiffre dans le nom de la propriété enregistrée precedement

a partir de la on peut jouer avec ces propriétés comme bon nous semble

maintenant il nous faut l'inverse losque l'on sort du bouton
et bien la c'est tout simple

dans l'enoncé de l'evenement "mousemove"
nous avons le Y et X qui nous donne la position de la souris sur le bouton
et bien la on y met une condition
"si Xest plus petit que "
"si x est plus grand que "
et pareil pour le Y
est des que X ou Y a une certaine valeur on appele la macro init qui remet le bouton a l'initial

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub GroupeBouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
nombouton = GroupeBouton.Name 'la variable 'nonmbouton prend pour  valeurle nom de l'active control
If IsNumeric(Right(nombouton, 2)) Then 'si les 2  derniers caracteres sont numeriques
i = Right(nombouton, 2) 'i=les deux derniers caracteres
Else
i = Right(nombouton, 1)
End If
GroupeBouton.BackColor = newcouleurbouton(i) 'ici j'inverse la couleur du text et du backcolor du bouton
GroupeBouton.ForeColor = newcouleurtext(i) 'ici j'inverse la couleur du text et du backcolor du bouton
GroupeBouton.Caption = UCase(GroupeBouton.Caption) 'met en minuscule le text de la caption
 
GroupeBouton.FontBold = True 'enleve l'attribu "en gras ' au text de la caption
GroupeBouton.Font.Italic = True 'met  l'attribu "en italic' au text de la caption
If X < 7 Or X > GroupeBouton.Width - 7 Then init 'si le x est plus petit que 7 apel routine init (7 etant une limite suffisante a evité les ratés)
If Y < 6 Or Y > GroupeBouton.Height - 6 Then init ' idem pour le y
End Sub

voila

veuillez me pardonnr si mon explication est maladroite mais l'auto didacte que je suis a fait de son mieux et je pense que meme si on est debutant les macros sont relativement simples

en esperant que ca vous soit utile


au plaisir

[Montor]

Cette partie du code ne sert à rien ...

Code :

1
2
3
4
5
6
7
8
9
10
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
   If fullscreen = False Then
   Call ReleaseCapture
   SendMessage hWnd, &HA1, 2, 0&
   Else
   Call ReleaseCapture
   End If
End If
End Sub

Malheureusement cette implémentation n'est pas très rebute elle échoue
facilement si on fait un mouvement rapide avec la souris ...
Le code suivant
fait la même chose mais fonctionne uniquement sur buttons placées directement sur la fiche...

[patricktoulon]

bonjour mentor

oui tu a raison

c'est tout simplement parce que j'avais supprimer la caption de l'userform
au départ ainsi il me fallait pouvoir le déplacer et j'ai supprimer cette partie pour ne laisser que la partie intéressante sur le sujet

voila
EDIT:
je viens de regarder ton fichier et il est nickel
mais un peu lourd a mon goût pour avoir l'effet surtout que c'est une fonction purement ergonomique(estetique)

on pourrait aussi puisque tu apprécie te servir des APIS créer des régions avec GDI ou GDIplus et mettre des conditions sur ces régions je vais essayer d'en bricoler un car c'est vrai qu'avec les apis c'est toujours plus rapide

au plaisir