combobox scroll down enabled

[VBABEGINER]

Hi all,

Vog sir this the new post.

In Combobox there are multiple values i have it.
i had try to enable the scrol property of combo...see below

With Worksheets("Sheet4").ComboBox1
.SmallScroll Down:=True

but this gives me error - run time 438 , object dosent support.

Can this possble....to scroll down enable?

 

[markfleet]

Hi,

This code is so nearly exactly what I need.

I have also noticed the issue that kketover describes. It appears as though the comboboxes remember the scroll position regardless of where the user manually scrolls to. I am working with large lists (several hundred items) where the user would normally type the first letter or scroll to roughly the correct place and then want to use the scroll wheel to locate the correct item. Unfortunately the list will jump back to the top.

Anyone have a solution for this?

Many thanks

Mark

 

[markfleet]

I think that I may have found the answer to my question actually...

See commented out / amended lines below. I am no longer memorizing the iTopIndex. I am simply adjusting the actual TopIndex (which does change when the user manually scrolls, starts typing to find a match etc).

'====================='
'\\ 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 = .TopIndex - 1
                    'iTopIndex = .TopIndex
                Else
                    .TopIndex = .TopIndex + 1
                    'iTopIndex = .TopIndex
                End If
            End With
            LowLevelMouseProc = -1
            Exit Function
        End If
    End If


    LowLevelMouseProc = _
    CallNextHookEx(lLowLevelMouse, nCode, wParam, ByVal lParam)
    
End Function

I have not done much testing of this yet but it seems promising so far.

Kind regards

Mark

 

[JChojnacki]

Awesome.
Thanks a bunch.

 

[Saturion]

Jaafar's code is perfect, the first Code which used to work. But not in all ExelVersion. Exel2016 x64 crashs after few seconds scroling.(It works but after few seconds Exel crashes "Microsoftr Exel has stoped working"....) But another Computer with WIndows 7 and Office 2006 it works perfect. Any idee what causes my Exel 2016 to crash?
Greetings and big Thanks to Jaafar

 

[Jaafar Tribak]

Jaafar's code is perfect, the first Code which used to work. But not in all ExelVersion. Exel2016 x64 crashs after few seconds scroling.(It works but after few seconds Exel crashes "Microsoftr Exel has stoped working"....) But another Computer with WIndows 7 and Office 2006 it works perfect. Any idee what causes my Exel 2016 to crash?
Greetings and big Thanks to Jaafar

If the combobox is on a worksheet try using the code I posted in Post#24
If the combobox is on a UserForm try using the code I posted in Post#28

 

[pinkstarbursts]

If the combobox is on a worksheet try using the code I posted in Post#24
If the combobox is on a UserForm try using the code I posted in Post[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=28]#28 [/URL]

I have tried using the code from Post #28 for my UserForm. I have a list box on my UserForm, and I would like the listbox to always be scrollable, even if it is not the focus. Is it possible to adjust this code so that once the UserForm is loaded the listbox will be the primary scroll until a combo-box is selected?

I tried adding

ScrollWheel.MakeScrollableWithMouseWheel(Me.ListComponents) = True

to my UserForm_Initialize sub and then

ScrollWheel.MakeScrollableWithMouseWheel(Me.ListComponents) = False

to the UserForm_Terminate sub

Also, it seems that while the UserForm is open I am unable to scroll in any other application. Is this normal behavior?

Thanks!

 

[avitzavi]

This crashes after about 3 seconds of scrolling on MS2013 64 bit

Ok - Here is an update that works for 32 and 64 Bits ... This update also addresses the issue mentioned in the previous post by kketover .

Should also work for ListBoxes .

1- In a Standard Module :

Option Explicit

Private Type POINTAPI
  x As Long
  y As Long
End Type


Private Type MSLLHOOKSTRUCT
    pt As POINTAPI
    mousedata As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type


Private Const HC_ACTION = 0
Private Const WH_MOUSE_LL = 14
Private Const WM_MOUSEWHEEL = &H20A
Private Const GWL_HINSTANCE = (-6)
Private oObject As Object
Private bHooked As Boolean


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private lLowLevelMouse As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    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
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Private lLowLevelMouse As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


'====================='
'\\ Public Routines   '
'====================='
Public Property Let MakeScrollableWithMouseWheel(ByVal Obj As Object, ByVal vNewValue As Boolean)
    If vNewValue Then
        Hook_Mouse
    Else
        UnHook_Mouse
    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  '
'====================='
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function LowLevelMouseProc(ByVal ncode As Long, ByVal wParam As LongPtr, lParam As MSLLHOOKSTRUCT) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function LowLevelMouseProc(ByVal ncode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    On Error Resume Next
    If (ncode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            With oObject
                If lParam.mousedata > 0 Then
                    .TopIndex = .TopIndex - 1
                Else
                    .TopIndex = .TopIndex + 1
                End If
            End With
            LowLevelMouseProc = -1
            Exit Function
        End If
    End If
    LowLevelMouseProc = CallNextHookEx(lLowLevelMouse, ncode, wParam, ByVal lParam)
End Function


Private Sub Hook_Mouse()
    If lLowLevelMouse = 0 Then
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
            lLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.HinstancePtr, 0)
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
            lLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    End If
End Sub


Private Sub UnHook_Mouse()
    If lLowLevelMouse <> 0 Then UnhookWindowsHookEx lLowLevelMouse: lLowLevelMouse = 0
End Sub

2- In the Worksheet Module where the ComboBox is located :

Option Explicit


Private WithEvents wb As Workbook


Private Sub ComboBox1_GotFocus()
    Set wb = ThisWorkbook
    MakeScrollableWithMouseWheel(ComboBox1) = True
End Sub


Private Sub ComboBox1_LostFocus()
    MakeScrollableWithMouseWheel(ComboBox1) = False
End Sub


Private Sub wb_BeforeClose(Cancel As Boolean)
    If MakeScrollableWithMouseWheel(ComboBox1) Then
        MakeScrollableWithMouseWheel(ComboBox1) = False
    End If
End Sub

 

[avitzavi]

Actually the code in #24 crashes my excel after about 3 seconds of scrolling...

If the combobox is on a worksheet try using the code I posted in Post[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=24]#24 [/URL]
If the combobox is on a UserForm try using the code I posted in Post#28

 

[Ardmore7]

in "Design Mode"; with combo box selected; click "Properties" from menu; try setting "AutoSize" to "True"; it worked for me

 

[JLEIngenieros]

Absolutelly fantastic.
Thanks