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