XL 2019 Evénement MouseMove sur formulaire

[ceralpes]

Bonjour à tous,
Ma question porte sur la présentation de boutons de commande sur un formulaire.
J'ai voulu faire un peu d'esthétisme sur mon formulaire en changeant la couleur de mes boutons de commande au survol de ma souris.
J'ai pour cela utilisé l'événement "MouseMove" sur l'UserForm1 ainsi que sur chaques boutons.
Cela fonctionne bien en dessous de 10 boutons déclarés mais si je rajoute plus de boutons, le visuel devient instable, même quand le curseur se promène sur le formulaire.
Ci-joint le fichier pour un aperçu.
Ma procédure est-elle correcte, et pourquoi cela fonctionne bien pour 5 ou 10 événements et pas plus.
Merci de votre aide.
Cordialement
Laurent

 

[patricktoulon]

bonjour
ho lala mon pauvre ami ce n'est pas comme ça qu'il faut s'y prendre pour faire un rollhover sur bouttons
punaise le repaint du userform il en prend un coup la

 

[patricktoulon]

un exemple simple sans module classe a fin que tu comprenne le principe

principe qui est :
si quand on survole un bouton(label) et qu'un précédent a été survolé on re met le précédent a l'initial et on mémorise l'actuel
dans ton system tu inverse simplement les couleur pas la peine d'aller chercher les long

comment on y arrive
2 sub : restorecolor et invertcolor (ctrl)
le passage de l'un appele la restore au cas ou oldcontrol ne serait pas rien et inversion couleur pour l'actuel puis memorisation
et ainsi de suite
dans le mouse du userform pareil si oldcontrol n'est pas rien alors restorecolor
terminée les crise d' épilepsie

Dim oldcontrol As Object
Sub restorecolor()
  Dim B&
  If Not oldcontrol Is Nothing Then
        B = oldcontrol.BackColor
        oldcontrol.BackColor = oldcontrol.ForeColor
        oldcontrol.ForeColor = B
    oldcontrol.BorderColor = B
    End If
    Set oldcontrol = Nothing
End Sub

Sub InvertColor(ctrl As Object)
Dim B&
If Not oldcontrol Is Nothing Then If oldcontrol Is ctrl Then Exit Sub Else restorecolor
     B = ctrl.BackColor
    ctrl.BackColor = ctrl.ForeColor
    ctrl.ForeColor = B
   ctrl.BorderColor = ctrl.ForeColor
   Set oldcontrol = ctrl
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    restorecolor
End Sub

' --------------------------------------------------------------------------------------------------------------------------------------------

Private Sub b_RAZ_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    InvertColor b_RAZ
End Sub

Private Sub b_DonneesAff_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    InvertColor b_DonneesAff
End Sub

Private Sub b_ModifierDonneesAff_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 InvertColor b_ModifierDonneesAff
 End Sub

Private Sub b_CreerConv_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   InvertColor b_CreerConv
End Sub

Private Sub b_ModifierAjoutEP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
InvertColor b_ModifierAjoutEP
End Sub

Private Sub b_ModifierAjoutFT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_ModifierAjoutFT
  End Sub

Private Sub b_ModifierProprio_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_ModifierProprio
  End Sub

Private Sub b_ModifierCadastre_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 InvertColor b_ModifierCadastre
 End Sub

Private Sub b_ModifierTechnique_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 InvertColor b_ModifierTechnique
 End Sub

Private Sub b_SupprimerConv_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_SupprimerConv
  End Sub

Private Sub b_ImportEDP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 InvertColor b_ImportEDP
 End Sub

Private Sub b_EnregistrerSous_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_EnregistrerSous
  End Sub

Private Sub b_ImprimeConv_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_ImprimeConv
  End Sub

Private Sub b_ImprimeConvEP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_ImprimeConvEP
  End Sub

Private Sub b_ImprimeConvFT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_ImprimeConvFT
  End Sub

Private Sub b_LettreEnvoi_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
InvertColor b_LettreEnvoi
End Sub

Private Sub b_Statut_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 InvertColor b_Statut
 End Sub

Private Sub b_EDPImprimerER_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_EDPImprimerER
  End Sub

Private Sub b_EDPImprimerEP_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_EDPImprimerEP
  End Sub

Private Sub b_EDPImprimerFT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_EDPImprimerFT
  End Sub

Private Sub b_EDP_ER_to_PDFImage1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_EDP_ER_to_PDFImage1
  End Sub

Private Sub b_EDP_EP_to_PDFImage2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   InvertColor b_EDP_EP_to_PDFImage2
   End Sub

Private Sub b_EDP_FT_to_PDFImage3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 InvertColor b_EDP_FT_to_PDFImage3
 End Sub

Private Sub b_Destinataire_ER_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_Destinataire_ER
  End Sub

Private Sub b_Destinataire_FT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_Destinataire_FT
  End Sub

Private Sub b_Annuler_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 InvertColor b_Annuler
 End Sub

Private Sub b_Enregistrer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  InvertColor b_Enregistrer
  End Sub

on peut encore plus simplifier en classant les boutons mais j'ai préféré rester avec les events propres a chacun pour que tu puisse comprendre la mécanique
Patrick

 

[sylvanu]

Bonjour Ceralpes, Patrick,
Pas assez rapide, mais puisque c'est fait ... , une autre approche :

En module :
Public a As Boolean

Dans toutes les macros on remplace
End Sub par
a=True:End sub

et dans la 1ere macro on met :
If a = False Then Exit Sub
et à la fin
a=False:End sub

donc on ne "repeint" que si un bouton a été survolé.

 

[patricktoulon]

re
c'est pa bon sylvanu le userform continu a clignoter 😉

 

[sylvanu]

Re,
Sur mon vieux 2007, ça marche. Soit mon PC est trop vieux, soit c'est XL, soit c'est moi. 🙂

 

[Dudu2]

Bonjour,
Avec un petit flag ça peut le faire.


Edit: bon en fait c'est la même technique que @sylvanu !

Edit: pour que ça ne "vibre" pas en survol très rapide il faudrait personnaliser le reset sur le Control "MouseMové", mais bon là je laisse faire l'auteur parce que c'est du boulot vu le nombre de Controls.

 

[patricktoulon]

re
non @sylvanu c'est pas le switch couleur le problème c'est le repaint r
Regarde ta propre capture quand tu passe vite sur x controls c'est d'autres qui clignotent

c'est pas une question de flag




dans mon model un seul (ancien)control est repaint si il ne l'ai pas déjà

et si on veut simplifier on classe même intra userform
et les puristes n'ont qu'a faire la même chose dans une classe

Public WithEvents bt As msforms.Label
Dim cls() As New UserForm1
Public oldcontrol As Object
Sub restorecolor()
    Dim B&
    If Not UserForm1.oldcontrol Is Nothing Then
        B = UserForm1.oldcontrol.BackColor
        UserForm1.oldcontrol.BackColor = UserForm1.oldcontrol.ForeColor
        UserForm1.oldcontrol.ForeColor = B
        UserForm1.oldcontrol.BorderColor = B
    End If
    Set UserForm1.oldcontrol = Nothing
End Sub

Sub InvertColor(ctrl As Object)
    Dim B&
    If Not UserForm1.oldcontrol Is Nothing Then If UserForm1.oldcontrol Is ctrl Then Exit Sub Else restorecolor
    B = ctrl.BackColor
    ctrl.BackColor = ctrl.ForeColor
    ctrl.ForeColor = B
    ctrl.BorderColor = ctrl.ForeColor
    Set UserForm1.oldcontrol = ctrl
End Sub

Private Sub UserForm_Activate()
   Dim ctrl, a&
   For Each ctrl In Me.Controls
        If ctrl.Tag = "x" Then
            a = a + 1: ReDim Preserve cls(1 To a): Set cls(a).bt = ctrl
        End If
    Next
End Sub
Private Sub bt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    InvertColor bt
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    restorecolor
End Sub

terminé tu l'( a ton rollHover et tu peux ajouter autant de bouton que tu veux
il te suffit de le taguer avec un "x"

 

[ceralpes]

Bonjour Patrick,
En faite, J'ai compris que j'ouvrais par mes survol beaucoup d'events non remis à l'initial . . . à rendre dingue l'userform.
Merci pour ta rapidité et surtout pour tes explications.
Je ne connaissais pas restorecolor et invertcolor, maintenant j'ai compris le principe.
Merci

 

[patricktoulon]

re
@Dudu2 aussi

avec mon modèle vous avez pas ce défaut de scintillement

 

[ceralpes]

Merci Sylvanu et Dudu2 pour votre participation et vos solutions.
La procédure de Patrick est vraiment parfaite, sur xl2019, plus de scintillements.
Merci à tous, je peux clôturer.

 

[patricktoulon]

re

Je ne connaissais pas restorecolor et invertcolor, maintenant j'ai compris le principe.

ben en fait elle n'existaient pas c'est moi qui ai créer ses deux sub
j'aurais très bien pu les appeller pierre ,paul ,jacques
le principe est assez simple
il suffit de memoriser dans une variable object le control entrain d'être survoler
mais avant tester si cette variable n'est pas rien et si elle est un précédent control survolé il est remis en inversant les couleurs
simple on trvaille en fait l'ors de l'action de survol sur 1 ou 2 controls c'est tout

 

[patricktoulon]

@ceralpes
si et quand tu aura le temps intéresse toi quand même au module classe ou classement intra userform
comme dans mon exemple 2 c'est quand même bien pratique pour réduire le code qui peut devenir lourdaud et pénible a maintenir

 

[ceralpes]

Oui je vais approfondir ça.
En tout cas, bien vu, tes 2 sub fonctionne parfaitement.