Autres toutes versions tester le scrool avec la roulette sans passer par un hooking en addressof

  If ActualControl Is control Then Exit Sub
      Set ActualControl = control

Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    SheetMouseWheel ListBox2
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    SheetMouseWheel ListBox1
End Sub

Sub SheetMouseWheel(control As Object)
    'MESSAGE SOURIS POUR LES CONTROLS DANS FEUILLE
    Const WM_MOUSEWHEEL = &H20A, PM_NOREMOVE = &H0&
    Dim tMsg As Msg, ldelta As Integer, pos As POINTAPI, criter As Boolean, rc As Rect, OnSheet As Boolean
      If ActualControl Is control Then Exit Sub
      Set ActualControl = control
      '...
      '...
      '...'

Option Explicit
Public looping As Boolean
Public ActualControl As Object
Public holdarea$
Public py&
Private Type POINTAPI: X As Long: Y As Long: End Type
Type Rect: left As Long: top As Long: right As Long: bottom As Long: End Type
#If VBA7 Then
    Private Type Msg: hWnd As LongPtr: message As Long: wParam As LongPtr: lParam As LongPtr: time As Long: pt As POINTAPI: End Type
    Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    #If Win64 Then
        Private Const NULL_PTR = 0
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal point As LongLong) As LongPtr
        Private Type t8: L As LongLong: End Type
        Private Function PointApiToLong(point As POINTAPI) As LongLong
            Dim t As t8
            LSet t = point
            PointApiToLong = t.L
        End Function
    #Else
        Private Const NULL_PTR = 0&
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
    #End If
        Private Function HIWORD(ByVal LongIn As LongPtr) As Integer
            On Error Resume Next
            HIWORD = (CLng(LongIn) And (&HFFFF0000)) \ (&H10000)
            On Error GoTo 0
        End Function  
#Else
    Private Type Msg: hWnd As Long: message As Long: wParam As Long: lParam As Long: time As Long: pt As POINTAPI: End Type
    Private Const NULL_PTR = 0&
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare Function WaitMessage Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Function HIWORD(ByVal LongIn As Long) As Integer
        HIWORD = (LongIn And (&HFFFF0000)) \ (&H10000)
    End Function
#End If
'************************************************************************************************************************
'************************************************************************************************************************
Sub ss(): Set ActualControl = Nothing: End Sub 'ce n'est pas ActiveControl mais ActualControl