XL 2013 survol de la souris

[gena]

bonjour le forum
je tente un nouveaux essaie mais cela fonctionne a un quart
je recherche comment changer la couleur des boutons en feuille 1 aux survol de la souris de gris passé aux vert ou autre couleur car je voudrais pas devoir copier 10 fois le même code pour chaque boutons
pour l'userform ok cela fonctionne très bien j'ai trouvé un code de grand maitre BOISGONTIER
comme exemple dans la feuille 2
pouvez vous m'aidé svp cela me rendrais service
avec tout ma gratitude

 

[danielco]

Bonjour,

Apparemment, tes boutons ne sont pas des contrôles ActiveX.

Daniel

 

[job75]

Bonjour gena, danielco,

Oui, pour que l'évènement MouseMove soit créé il faut que le contrôle soit un contrôle ActiveX, donc ici un CommandButton.

Et si l'on ne veut pas répéter 10 fois le code créer un Module de classe.

A+

 

[sylvanu]

Bonjour Gena, Danielco, Job,
Ce n'est pas bien de ne pas lire Le Grand Maître jusqu'au bout !

( Bulle au survol d'une forme : http://boisgontierjacques.free.fr/pages_site/evenements.htm#MouseMove )

En utilisant des formes pour déclencher vos macros, ça marche :

 

[gena]

merci infiniment j ai réussis a le faire fontionné comme prévus le boutons en feuille 2 fonctionne mais comment faire pour la totalité de la feuille 1

 

[sylvanu]

Re Bonsoir tout le monde,
En PJ un essai avec 5 boutons.
Je suis passer par des formes car je les trouve plus esthétiques.
A chaque bouton sont associées ces deux macros :

Private Sub Label4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  d = 3
  If X < d Or X > Label4.Width - d Or Y < d Or Y > Label4.Height - d Then
     ActiveSheet.Shapes("Rect1").Fill.ForeColor.RGB = RGB(0, 255, 0)
  Else
     ActiveSheet.Shapes("Rect1").Fill.ForeColor.RGB = RGB(255, 0, 0)
   End If
End Sub

'Macro quand clic sur le bouton
Private Sub Label4_Click()
    ActiveSheet.Shapes("Rect1").Fill.ForeColor.RGB = RGB(0, 255, 0)
    MsgBox "Appui sur Bouton 1"
End Sub

 

[job75]

Salut sylvanu,

comment faire pour la totalité de la feuille 1

J'ai parlé de module de classe, ce n'est pas difficile à mettre en oeuvre, voyez le fichier joint.

 

[gena]

merci beaucoup JOB toujours aussi prince
j'ai réussis à mettre un boutons opérationnelle mais dix cela est pour mon niveau casse tète
mais j'apprend vite a vos coté

 

[gena]

j 'avais presque réussis il me manque un note cela

Option Explicit
Public WithEvents CB As MSForms.CommandButton

merci infiniment

 

[job75]

Aussi n'oubliez pas le code dans ThisWorkbook.

 

[gena]

OUI celui je l'avais pas du tout a coté de la plaque
encore MERCI

 

[gena]

si cela peut aidé une personne j ai rajouté cela dans le code pour changer l' écriture des boutons

 CB.ForeColor = RGB(255,250,250)

pour le blanc

 

[patricktoulon]

re
bonjour
c'est pas bon par le x et y : si on va trop vite sur le bouton on garde la couleur

 

[gena]

merci beaucoup effectivement cela le fait de temps en temps je recherche la solution

 

[patricktoulon]

ben il n'y en a pas because c'est le mouvement d'un autre élément qui doit déclencher le retour alors quand tu passe sur un autre c'est possible mais quand tu es sur la feuille ben c'est walouh
peut etre une rechap avec un timer mais c'est très BOF
en général ça se passe mieux dans un userform
la solution serait de mettre tes 10 bouton sur un label transparent
le move de ce label remettrais le dernier passé en vert en rouge
de ce fait tu dégage cette méthode du x et y qui est bidon


donc dans le thisworkbook
on reprends le code et on ajoute le label qui nous sert de fond derrière les boutons
dans chaque instance de la classe pour les boutons

Option Explicit
Dim CB() As New Classe1

Private Sub Workbook_Open()
Dim o As OLEObject, n%
For Each o In Feuil1.OLEObjects
    If TypeName(o.Object) = "CommandButton" Then
        ReDim Preserve CB(n)
        Set CB(n).CB = o.Object
        Set CB(n).lab = Feuil1.OLEObjects("Label1").Object
        n = n + 1
    End If
Next

End Sub

la classe

Option Explicit
Public WithEvents CB As MSForms.CommandButton
Public WithEvents lab As MSForms.Label
Public old As Object
Private Sub CB_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    CB.BackColor = vbgreen
    Set old = CB
End Sub

Private Sub Lab_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Not old Is Nothing Then old.BackColor = vbRed
End Sub

démonstration

en fonctionnement