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?

 

[Ruddles]

Your code appears to be actually trying to scroll down a combobox but you can't do that - the user has to do it. That scroll command is only applicable to a worksheet.

If you're trying to set some sort of scroll property of a combobox, I don't think you need to do that - comboboxes should always be scrollable. Where did you see a reference to this 'scroll' property?

Can you explain what is it that you're actually trying to achieve?

 

[VBABEGINER]

Your code appears to be trying to scroll down a combobox but you can't do that - the user has to do it. - Yes, Excatly right.

That scroll command is only applicable to a worksheet. - but i took a combo box on worksheet only.

comboboxes should always be scrollable. - Yes, Excatly Sir...combobox always have scrollable idea.
But Sir, here as i scroll with scroller in mouse, mouse pointer goes on each every items, this is fine. ..but if i scroll with scroller on that list then only my list will scrolls up and down.....not excel sheet. here sheet goes up and down

 

[Ruddles]

No, I'm sorry, I'm afraid I'm not following you. Are you saying that you want the combobox to stay 'locked' in position on the screen when you scroll the sheet up and down?

Perhaps if you post your problem in your primary language, someone will know exactly what you're trying to achieve and help with a solution.

 

[Jaafar Tribak]

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 :

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)

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.

 

[Maximus Tatius]

I just found this and I wanted to confirm that Jaafar Tribak's solution works a treat, and to add another little tip for future readers.

I have several combo boxes on the same spreadsheet and was having this annoying problem where the worksheet scrolls instead of the cb list. This fixed it but, if you have more than one combo box remember to change the second bit of code to read like this to add a second combo box, etc...

Option Explicit

Private WithEvents wb As Workbook


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

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

' For ComboBox2
Private Sub ComboBox2_GotFocus()
    Set wb = ThisWorkbook
    MakeScrollableWithMouseWheel(ComboBox2) = True
End Sub

Private Sub ComboBox2_LostFocus()
    MakeScrollableWithMouseWheel(ComboBox2) = False
End Sub

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

' For ComboBox2
If MakeScrollableWithMouseWheel(ComboBox1) Then
        MakeScrollableWithMouseWheel(ComboBox1) = False
End If

End Sub

 

[Maximus Tatius]

Oops, sorry, I made a little mistake in "Sub wb_BeforeClose". Here's the corrected code:

Option Explicit

Private WithEvents wb As Workbook


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

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

' For ComboBox2
Private Sub ComboBox2_GotFocus()
    Set wb = ThisWorkbook
    MakeScrollableWithMouseWheel(ComboBox2) = True
End Sub

Private Sub ComboBox2_LostFocus()
    MakeScrollableWithMouseWheel(ComboBox2) = False
End Sub

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

' For ComboBox2
 If MakeScrollableWithMouseWheel(ComboBox[COLOR=#ff0000][B]2[/B][/COLOR]) Then
         MakeScrollableWithMouseWheel(ComboBox[COLOR=#ff0000][B]2[/B][/COLOR]) = False
End If

 End Sub

 

[spotlitekid]

Oops, sorry, I made a little mistake in "Sub wb_BeforeClose". Here's the corrected code:

Option Explicit

Private WithEvents wb As Workbook


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

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

' For ComboBox2
Private Sub ComboBox2_GotFocus()
    Set wb = ThisWorkbook
    MakeScrollableWithMouseWheel(ComboBox2) = True
End Sub

Private Sub ComboBox2_LostFocus()
    MakeScrollableWithMouseWheel(ComboBox2) = False
End Sub

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

' For ComboBox2
 If MakeScrollableWithMouseWheel(ComboBox[COLOR=#ff0000][B]2[/B][/COLOR]) Then
         MakeScrollableWithMouseWheel(ComboBox[COLOR=#ff0000][B]2[/B][/COLOR]) = False
End If

 End Sub

This code stops on the first sentence. "Private WithEvents wb As Workbook". COuld this be because i am using excel 2007?

 

[spotlitekid]

Sorry, I am using Excel 2003 and the code does not work. It blows up on the first sentence. Private WithEvents wb As Workbook

 

[Maximus Tatius]

Does Jaafar's demo spreadsheet work for you?

http://www.box.net/shared/qmd6iz615vqf4vd3hodm

[edit: click the download button at the top of that page]