Discussion :

[BrainError]

Bonsoir,

Je débute pour ce qui est de programmer en VBA sur excel et je me suis retrouvé confronter à un problème que je ne parvient à résoudre d'aucune manière satisfaisante !

Je cherche à simuler un événement "MouseOver" (comme il existe en javascript par exemple) sur un contrôle et non pas seulement l'événement MouseMove classique disponible pour tout les contrôles.
Je veux dire par là que l'événement doit prendre fin lorsque le curseur quitte le contrôle, ce qui n'est pas le cas avec l'événement MouseMove (si je ne me trompe pas).
Autre paramètre important, le contrôle en question se trouve directement sur ma feuille de calcul et non pas dans un Userform (impossible donc de se servir d'un second MouseMove sur l'Userform).

Je suis parvenu à un résultat qui fonctionne par le biais de la fonction GetCursorPos de la librairie User32. Voici mon code :

Dans un module :

Code VBA :

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

1
2
3
4
5
6
7
Option Explicit
 
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Type POINTAPI
    X_Pos As Long
    Y_Pos As Long
End Type

Sur ma feuille contenant le contrôle concerné :

Code VBA :

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
Option Explicit
 
Private Sub Button_Reinitialiser_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    DoEvents
 
'Récuperer la position du curseur sur l'écran
    Dim Hold As POINTAPI
    GetCursorPos Hold
 
'Changement progressif de couleur de fond d'une cellule
    Dim TimerMemory As Single
    If ActiveSheet.Cells(7, 5).Interior.Color <> RGB(80, 200, 80) Then
        TimerMemory = Timer + 0.15
        Do While Timer < TimerMemory
            ActiveSheet.Cells(7, 5).Interior.Color = RGB(255 - (255 - 80) * (1 - (TimerMemory - Timer) / 0.15), 255 - (255 - 200) * (1 - (TimerMemory - Timer) / 0.15), 255 - (255 - 80) * (1 - (TimerMemory - Timer) / 0.15))
        Loop
        ActiveSheet.Cells(7, 5).Interior.Color = RGB(80, 200, 80)
    End If
 
'Boucle "Tant que le curseur se trouve dans les limites du contrôle"
    Do While ActiveWindow.ActivePane.PointsToScreenPixelsX(Me.Button_Reinitialiser.Left) < Hold.X_Pos _
            And Hold.X_Pos < ActiveWindow.ActivePane.PointsToScreenPixelsX(Me.Button_Reinitialiser.Left + Me.Button_Reinitialiser.Width) _
            And ActiveWindow.ActivePane.PointsToScreenPixelsY(Me.Button_Reinitialiser.Top) < Hold.Y_Pos _
            And Hold.Y_Pos < ActiveWindow.ActivePane.PointsToScreenPixelsY(Me.Button_Reinitialiser.Top + Me.Button_Reinitialiser.Height)
        GetCursorPos Hold
    Loop
 
'Dès que le curseur quitte le contrôle, retrait progressif de la couleur de fond de la cellule
    If ActiveSheet.Cells(7, 5).Interior.Color = RGB(80, 200, 80) Then
        TimerMemory = Timer + 0.15
        Do While Timer < TimerMemory
            DoEvents
            ActiveSheet.Cells(7, 5).Interior.Color = RGB(80 + (255 - 80) * (1 - (TimerMemory - Timer) / 0.15), 200 + (255 - 200) * (1 - (TimerMemory - Timer) / 0.15), 80 + (255 - 80) * (1 - (TimerMemory - Timer) / 0.15))
        Loop
        ActiveSheet.Cells(7, 5).Interior.Color = xlNone
    End If
End Sub

Le problème de ce code, c'est que tant que la boucle contrôlant la présence du curseur sur le contrôle est actif, il m'est impossible de cliquer sur le bouton.
La boucle empêche l'événement Click de se déclencher .

Il y aurait-il une solution envisageable pour forcer l'événement Click à ce déclencher malgré la boucle ?
Ou peut-être un moyen alternatif de procéder ?

Merci d'avance !!

Voici un classeur exemple : MouseOver.xlsm

[unparia]

Bonjour
Cette assertion :

Je veux dire par là que l'événement doit prendre fin lorsque le curseur quitte le contrôle, ce qui n'est pas le cas avec l'événement MouseMove (si je ne me trompe pas).

est fausse, telle qu'ainsi exprimée !

[BrainError]

Hum, peut-être devrais-je dire que les procédures déclenchée par l'événement MouseMove sont permanentes et qu'il n'y a pas de retour en arrière possible (comme pour un MouseOver), dans ce cas ?
Et que je souhaite justement programmer ce retour en arrière ? Et conserver la possibilité de déclencher l'événement Click ?

[unparia]

Hum, peut-être devrais-je dire que les procédures déclenchée par l'événement MouseMove sont permanentes, et qu'il n'y a pas de retour en arrière possible (comme pour un MouseOver) dans ce cas ?

Assertion toute aussi fausse que la première
Et qui en dit énormément sur ta compréhension des choses.

[BrainError]

Quelle serait la bonne assertion dans ce cas ?
Comme je l'ai précisé, je débute avec VBA .

[unparia]

Quelle serait la bonne assertion dans ce cas ?

Drôle de question (elle remet d'ailleurs également en cause des connaissances dans d'autres langages !)
Réponse (quel que soit le langage) : un évènement ne survient que lorsque les conditions de sa survenue subsistent et cesse de survenir dès que ces conditions ne sont plus là !
Ainsi : l'évènement MouseMove d'un contrôle ne survient que lorsque la souris survole ce contrôle et cesse de survenir dès lors que la souris ne survole plus ce contrôle !

Ce que te permettrait de vérifier une utilisation toute bête de msgbox

Ton problème n'est pas que cet évènement "subsisterait", mais de déterminer quand il cesse de survenir ...

Et j'arrête maintenant là, car on s'écarte de la vocation fondamentale d'un classeur (encore plus si tu es débutant).
Juste un mot : les coordonnées et dimensions d'un contrôle activex sur une feuille de calcul sont exprimées en POINTS, par rapport à l'angle supérieur gauche de la fenêtre ACTIVEwINDOW;
Les coordonnées retournées par la fonction de l'Api de Windows que tu emploies sont, elles, exprimées en PIXELS par rapport à l'angle supérieur gauche de ton ECRAN.
Je te laisse maintenant là.

[patricktoulon]

re
oulalahhh

ca me ramene quelques années en arriere ca avec une boucle perpetuelle avec rupteur sur getcursorpos

bon depuis je refléchi quand meme

je te propose donc ne ne pas faire souffrir ta memoire et processeur en suppriment le besoins de boucle et en donnant meme un micro instant de repos a ton processeur

ALORS:
ca consiste a mettre le bouton d'une couleur au passage de la souris puis apres un court sleep tester le typename de "activewindow.rangefrompoint"
et bien evidement si ce n'est pas oleobject mais "Range" on ne survole donc plus sur le bouton

et voila encore un militaire qui gagne une tringle a rideau
donc pour commencer il nous faut les deux api et la variable type pour les position

voila

Code :

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

1
2
3
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI:    X As Long:    Y As Long: End Type

et maintenat l'evenement mouse_move du bouton

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim pos As POINTAPI
    With CommandButton1
        If .BackColor <> vbRed Then .BackColor = vbRed
          Sleep 50
        GetCursorPos pos
        If TypeName(ActiveWindow.RangeFromPoint(pos.X, pos.Y)) = "Range" Then .BackColor = vbGreen
    End With
End Sub

voila en douceur pas de galere dans le teston




edit: tout ca dans le module du sheets ou se trou_ve le bouton bien sur hein je le precise au cas ou !!!

[BrainError]

Ahhhh !!

C'est tellement plus simple !

Je ne connaissais pas RangeFromPoint.

Merci beaucoup !

Je marque résolu, tout fonctionne avec cette méthode .

[pijaku]

Bonjour,

Si les cellules derrière et autour du bouton (ou du contrôle) ne doivent pas être utilisées, le plus simple est de :
> Dessiner un label suffisamment grand par rapport au contrôle, ***
> le rendre invisible (propriété BackStyle = 0 et Caption = ""), ***
> adjoindre ce simple code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.CommandButton1.BackColor = vbRed
End Sub
 
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.CommandButton1.BackColor = vbGreen
End Sub
 
Private Sub Worksheet_Activate()
    Me.CommandButton1.BackColor = vbGreen
End Sub

Nota : ici on change la couleur du bouton, mais l'action peut être toute autre...

*** Une image parlante :


EDIT : restera toujours le souci si l'on est en bordure de la feuille...

[unparia]

je mettais des jolies horloges sur mes feuilles avec

Ce sera déjà un premier vrai pas (que tu aurais du faire d'emblée, au lieu de rester scotché à Ontime).
Commence à chercher le second, sans hook et sans timer ( l' "épervier") et là, le pas sera ENORME.
Bonnes études, boulot et recherches ...