Scroll Wheel in a ListBox without a UserForm RRS feed

  • Question

  • Hi, I was reading and copying code to do this action, but my case is a bit different.

    I have my ListBox (LB) in a worksheet not on a UserForm (UF).

    My idea is permit to the user be able to use two option to find data,

    option 1 searching with the Scroll Wheel directly on the LB.

    option 2 use a cell to search data on this LB.

    I was reading this entry

    "Mouse scroll in UserForm ListBox in Excel 2010"

    (I can´t paste the link)  and I copied the code, but it doesn´t work and I don´t understand why, maybe because I don´t have the LB on a UF, so I´m looking for some help here.

    Thank you for your time!


    • Edited by Barpeing Friday, May 3, 2019 3:21 AM
    Friday, May 3, 2019 3:17 AM

All replies

  • Well, I was continuing investigated and found this Possible Solution, but the problem I can´t solve until now is while the LB is activated, it catches the mouse pointer and if I change the windows to, for example, my browser, the wheel doesn´t work on it and the pointer seem to be lazy, as the LB is continuing "reading" the position of the mouse pointer.  

    • In a new Standard Module
    Option Explicit
    Private Type POINTAPI
      x As Long
      y As Long
    End Type
        pt As POINTAPI
        mousedata As Long
        flags As Long
        time As Long
        dwExtraInfo As Long
    End Type
    Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (ByVal Destination As Long, _
    ByVal Source As Long, _
    ByVal Length As Long)
    Private Declare Function FindWindow Lib "user32.dll" _
    Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" _
    Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
    Private Declare Function SetWindowsHookEx Lib _
    "user32" _
    Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, _
    ByVal lpfn As Long, _
    ByVal hmod As Long, _
    ByVal dwThreadId As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" _
    (ByVal hHook As Long, _
    ByVal nCode As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" _
    (ByVal hHook As Long) As Long
    Private Const HC_ACTION = 0
    Private Const WH_MOUSE_LL = 14
    Private Const WM_MOUSEWHEEL = &H20A
    Private Const GWL_HINSTANCE = (-6)
    Private uParamStruct As MSLLHOOKSTRUCT
    Private oObject As Object
    Private lLowLevelMouse As Long
    Private bHooked As Boolean
    '\\ Public Routines   '
    Public Property Let MakeScrollableWithMouseWheel _
    (ByVal Obj As Object, ByVal vNewValue As Boolean)
        If vNewValue Then
        End If
        Set oObject = Obj
        bHooked = vNewValue
    End Property
    Public Property Get MakeScrollableWithMouseWheel _
    (ByVal Obj As Object) As Boolean
        MakeScrollableWithMouseWheel = bHooked
    End Property
    '\\ Private Routines  '
    Function LowLevelMouseProc _
    (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Static iTopIndex As Integer
        On Error Resume Next
        If (nCode = HC_ACTION) Then
            If wParam = WM_MOUSEWHEEL Then
                With oObject
                    If GetHookStruct(lParam).mousedata > 0 Then
                        .TopIndex = iTopIndex - 1
                        iTopIndex = .TopIndex
                        .TopIndex = iTopIndex + 1
                        iTopIndex = .TopIndex
                    End If
                End With
                LowLevelMouseProc = -1
                Exit Function
            End If
        End If
        LowLevelMouseProc = _
        CallNextHookEx(lLowLevelMouse, nCode, wParam, ByVal lParam)
    End Function
    Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
       CopyMemory VarPtr(uParamStruct), lParam, LenB(uParamStruct)
       GetHookStruct = uParamStruct
    End Function
    Private Function GetAppInstance() As Long
        GetAppInstance = GetWindowLong _
        (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
    End Function
    Private Sub Hook_Mouse()
        If lLowLevelMouse = 0 Then
            lLowLevelMouse = SetWindowsHookEx _
            (WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetAppInstance, 0)
        End If
    End Sub
    Private Sub UnHook_Mouse()
        If lLowLevelMouse <> 0 Then _
        UnhookWindowsHookEx lLowLevelMouse: lLowLevelMouse = 0
    End Sub
    • In the worksheet where I have the LB
    Private Sub ListBox1_GotFocus()
        Set wb = ThisWorkbook
        MakeScrollableWithMouseWheel(ListBox1) = True
    End Sub
    Private Sub ListBox1_LostFocus()
        MakeScrollableWithMouseWheel(ListBox1) = False
    End Sub
    Private Sub wb_BeforeClose(Cancel As Boolean)
        If MakeScrollableWithMouseWheel(ListBox1) Then
            MakeScrollableWithMouseWheel(ListBox1) = False
        End If
    End Sub

    This code belongs to Jaafar Tribak from mrexcel(dot)com, post: combobox scroll down enabled.

    I changed ComboBox1 for ListBox1

    • Edited by Barpeing Friday, May 3, 2019 4:56 AM
    Friday, May 3, 2019 4:54 AM