combobox scroll down enabled

V

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,284
Office Version
  1. 365
Platform
  1. Windows
Hi all,

Vog sir this the new post.:-D

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
Click to expand...

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

Can this possble....to scroll down enable?
 
Sort by date Sort by votes
I just found it, I did not update the control name. All is well!

Thanks, Craig



CraigMc said:
I'm stuck. I have downloaded the example sheet ComboMouseWheel.xls and the mouse scrolls fine. I cannot get the scroll to work in my worksheet. I have even gone as far as to export basMain and Sheet 1 from ComboMouseWheel.xls and imported them into my project. I have created a new combobox1 and populated it with a list. I have compared the two files ComboMouseWheel and my project and cannot find any differences. Ive even compared the ComboBox1 properties and they are the same.

So I am lost. The example sheet works, but my project does not.

The only symptom is that the mouse no longer scrolls in the VBA for Applications Editor. I get no errors, scrolling remains unavailable in the ComboBox.

Is there some small detail I am missing to enable mouse scrolling in VBA? Or have I missed the entire train?

Craig
Click to expand...
 
Upvote 0

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Hi everyone,

Jaafar, I just wanted to thank you for this code to make combo-boxes scrollable with the mouse wheel. It's a limitation thats been annoying me for a while!

The code works beautifully for a combobox I have on a worksheet, but I am having trouble getting it to work with comboboxes on a userform. What do I need to modify in order to make it work with comboboxes on a userform?

Many thanks,

Matt
 
Upvote 0
I have a question. I used this code (for multiple combo boxes in one sheet) and it works great. There is one behavior that I noticed that I wonder if anyone knows how to correct.

Let's say the combo box is a large list of names (last, first). You are looking for "Johnson, Mark" so you start typing. You type "joh" and the 1st Johnson ("Johnson, Alice") fills the box. You click the drop down to see the list and the list on the screen goes from "Johnson, Alice" to "Johnson, Larry". So you use the wheel to try to scroll down a little bit to get to "Johnson, Mark". Unfortunately, when you start to scroll, it jumps up to the top of the list, all the way back to A. Is there a way that you can change the code to start the scrolling at the current position in the list?

I know this is an old thread, but hopefully someone can take a look.

Thanks all!
 
Upvote 0
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 :

Code: 
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


#If 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
#Else
    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
#End 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  '
'====================='
#If VBA7 Then
    Private Function LowLevelMouseProc(ByVal ncode As Long, ByVal wParam As LongPtr, lParam As MSLLHOOKSTRUCT) As LongPtr
#Else
    Private Function LowLevelMouseProc(ByVal ncode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
#End 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
        #If VBA7 Then
            lLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.HinstancePtr, 0)
        #Else
            lLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
        #End 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 :

Code: 
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
 
Upvote 0
So I plugged in the new code and it worked great on my machine (Excel 2013). Unfortunately the tool I am building needs to function on 2007 and 2010 as well as 2013. I tested it with a user on 2010 and when she scrolled it crashed Excel. She got a "Microsoft Excel has stopped working" dialogue and the program closed. I have testing sessions with the 2007 user and a 2013 user on Friday. Any thoughts on why the new code would cause Excel 2010 to crash when the old code didn't?
 
Upvote 0
Thank you very much for this solution, but it doesn't seem to be working with my comboboxes. I think it may be because I am not using the form combobox but the activex combobox on a userform. I need to used the activex version as I need to be able to respond to events. Can you please tell me how I can adapt this code to work in this situation? Much appreciated.


Jaafar Tribak said:
I think the OP wants to scroll the ComboBox list with the mouse wheel.

Unfortunatly the mouse wheel srolling doesn't work for ActiveX Listboxes and combos - when you try to scroll the drop down list with the mouse wheel it is the worksheet that scrolls not the drop down.

Here is this generic MakeScrollableWithMouseWheel Property i wrote to work around this limitation.

Workbook demo.

1- Add a new standard module to your project and put this code in it :


Code: 
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 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
        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  '
'====================='

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
                Else
                    .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

2- Place the following code in the worksheet module (where you have the combobox)

Code: 
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
In fact, you can apply the same code to a listbox as well - just pass the ListBox object to the generic MakeScrollableWithMouseWheel Property in the corresponding listBox events.
Click to expand...
 
Upvote 0
Hi gagey,

Here is an example that worked for me :

Try the following in a new userform with two comboboxes (ComboBox1 and ComboBox2 -- You can make this work for any number of ComboBoxes/Listboxes as long as you adapt the code in the userform module))

Note: The comboboxes/ListBoxes could be placed directly on the userform or inside a frame or a Multipage :

1- The following code goes in a satandard module in your project :
Code: 
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

#If 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
#Else
    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
#End 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  '
'====================='
#If VBA7 Then
    Private Function LowLevelMouseProc(ByVal ncode As Long, ByVal wParam As LongPtr, lParam As MSLLHOOKSTRUCT) As LongPtr
#Else
    Private Function LowLevelMouseProc(ByVal ncode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
#End 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
        #If VBA7 Then
            lLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.HinstancePtr, 0)
        #Else
            lLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
        #End If
    End If
End Sub

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

2- The following code goes in the module of the userform :

Code: 
Option Explicit

Private Sub UserForm_Activate()
    Dim i As Long
    
    For i = 1 To 200
        Me.ComboBox1.AddItem i
        Me.ComboBox2.AddItem i * 100
    Next i
End Sub

Private Sub ComboBox1_Enter()
    MakeScrollableWithMouseWheel(ComboBox1) = True
End Sub

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    MakeScrollableWithMouseWheel(ComboBox1) = False
End Sub

Private Sub ComboBox2_Enter()
    MakeScrollableWithMouseWheel(ComboBox2) = True
End Sub

Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    MakeScrollableWithMouseWheel(ComboBox2) = False
End Sub
 
Upvote 0
Jaafar: Your code is beautiful...a true stroke of genius!

For those of you who may be interested, I developed the following code long before I saw Jaafar's much more elegant solution. I have since found that it works in concert with his. Mine does not scroll by moving the mouse wheel, but rather by pressing (and holding) the wheel button and moving the mouse up or down. The only real advantages over Jaafar's are that it will scroll faster through a listbox's or combobox's contents, and it will actually scroll the selection. The major disadvantage: You have to move the mouse and will often find yourself running out of travel space. The code highlighted in red can be uncommented to replace the adjacent "Exit Sub" in order to wrap around.

Code: 
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)   'Scroll list
Static ymove As Single
'Middle mouse button pressed, scrolled down
    If Button = 4 And ymove < y Then
     If ComboBox1.ListIndex = ComboBox1.ListCount - 1 Then Exit Sub [COLOR=#ff0000]'ComboBox1.ListIndex = -1[/COLOR]
        ComboBox1.ListIndex = ComboBox1.ListIndex + 1
    End If
'Middle mouse button pressed, scrolled up
    If Button = 4 And ymove > y Then
        If ComboBox1.ListIndex = -1 Then Exit Sub [COLOR=#ff0000]'ComboBox1.ListIndex = ComboBox1.ListCount -1[/COLOR]
        ComboBox1.ListIndex = ComboBox1.ListIndex - 1
    End If
ymove = y
End Sub



Regards,

CJ
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
Opening a User Form from Custom Ribbon Button Run-time and Complie issues
Replies
3
Views
501
Micron
M
J
  • Question Question
Trigger ActiveX ComboBox to display the drop down list VBA
Replies
8
Views
2K
julhs
J
K
  • Solved
making a userform components attribute names and values a two dimensional array.
Replies
1
Views
407
dmt32
D
D
  • Question Question
VBA Basic Userform - add -update -delete
Replies
3
Views
679
Drexi
D
L
  • Solved
Dynamic Named Range not working with Userform ComboBox
Replies
6
Views
959
NoSparks
N

Forum statistics

Threads
1,224,550
Messages
6,179,462
Members
452,915
Latest member
hannnahheileen

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top