ActiveX ListBox activation scrolls the worksheet

[bulletcss]

Hi there.

I'm doing VBA project, which incorporates ActiveX ListBox component. It's crucial for me to have a multiselect option with checkboxes. I use listbox change event to display information on selected items.

However, I faced some strange behaviour of listbox when it scrolls the sheet if it is activated (first time either leftclicked or rightcliked).
I have attached a picture which illustrates my issue. Activation of the listbox (left-click, right-click, ListBox.Activate, whatever) makes a sheet scroll. It happens if the listbox component size doesn't fit the screen.
Sometimes it even leads to selecting the wrong listbox item due to lag of clicking while the listbox is scrolling.

Note that if the component has already been activated, there is no subsequent scrolling. So once I have activated the ListBox by clicking on it (selecting an item), I can select other items without this scrolling issue.

I guess there is a workaround solution to resize ListBox once a sheet is zoomed in order to fit the component to a screen size. But I don't want to pursue this way, because ActiveX ListBox is prone to bugs and freezing when it is resized.

Could you please suggest any solution to this issue?

 

[Skyybot]

Would the use of a ComboBox yield the results that you are looking for?

 

[bulletcss]

Would the use of a ComboBox yield the results that you are looking for?

Unfortunately, not. It is crucial for me to have the option to display all variants and select some of them (multiple items simultaneously).

 

[Jaafar Tribak]

See if this workaround works for you ?

Place this code in the module of the worksheet in which the ListBox is located:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Me.ScrollArea <> "" Then
        Me.ScrollArea = ""
    End If
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.ScrollArea = ActiveWindow.VisibleRange.Address
End Sub

 

[Skyybot]

You should be able to display the same contents of a ListBox in a ComboBox. Only difference is that a ComboBox is scrollable.

Unfortunately, not. It is crucial for me to have the option to display all variants and select some of them (multiple items simultaneously).

Are you creating the ListBox programatically?

 

[bulletcss]

See if this workaround works for you ?

Place this code in the module of the worksheet in which the ListBox is located:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Me.ScrollArea <> "" Then
        Me.ScrollArea = ""
    End If
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.ScrollArea = ActiveWindow.VisibleRange.Address
End Sub

Looks like the right direction.

However, it blocks scrolling the sheet, which is required because the list of items is quite long. So it is not user-friendly, because user may occasionally move a mouse on the listbox and block scrolling of the sheet until any cell selection.

So I can't implement these code at the moment.

 

[bulletcss]

You should be able to display the same contents of a ListBox in a ComboBox. Only difference is that a ComboBox is scrollable.

Are you creating the ListBox programatically?

This vba project must allow user to select multiple items to show at the same time. Combobox doesn't fulfill the requirements.

 

[Jaafar Tribak]

Looks like the right direction.

However, it blocks scrolling the sheet, which is required because the list of items is quite long. So it is not user-friendly, because user may occasionally move a mouse on the listbox and block scrolling of the sheet until any cell selection.

So I can't implement these code at the moment.

In that case , you may need a slightly more elaborate code.

The code now goes into the ThisWorkbook Module and it assumes that the name of the worksheet where the ListBox is located is Sheet1 and it also assumes that the ListBox name is ListBox1 ... You can easily change these two as required via the two constants (SHEET_NAME and LISTBOX_NAME) which are defined at the top of the workbook module.

The code will take effect and run automatically upon first opening the workbook or when the workbook is activated.


ThisWorkbook Module:

Option Explicit

Private WithEvents ObjUnderCursor As CommandBars
Private WithEvents OListBox As MSForms.ListBox

Private Type POINTAPI
    X As Long
    Y As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function SetThreadExecutionState Lib "Kernel32.dll" (ByVal esFlags As Long) As Long
#Else
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function SetThreadExecutionState Lib "Kernel32.dll" (ByVal esFlags As Long) As Long
#End If

Private Const SHEET_NAME = "Sheet1"      '<== Change target Sheet name as required.
Private Const LISTBOX_NAME = "ListBox1"  '<== Change target ListBox name as required.


Private Sub Workbook_Activate()
    Call SetHooks(True)
End Sub

Private Sub Workbook_Deactivate()
    Call SetHooks(False)
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call SetHooks(True)
End Sub

Private Sub SetHooks(ByVal bHook As Boolean)
    With Sheets(SHEET_NAME)
        If bHook Then
            .ScrollArea = ""
            Set ObjUnderCursor = Application.CommandBars
            Set OListBox = .OLEObjects(LISTBOX_NAME).Object
        Else
            .ScrollArea = ""
            Set ObjUnderCursor = Nothing
            Set OListBox = Nothing
            PreventSleepMode = False
        End If
    End With
End Sub

Private Sub ObjUnderCursor_OnUpdate()

    Dim tCurPos As POINTAPI, oObj As Object

    Call GetCursorPos(tCurPos)
    Set oObj = ActiveWindow.RangeFromPoint(tCurPos.X, tCurPos.Y)
    If TypeName(oObj) <> "OLEObject" Then
        Sheets(SHEET_NAME).ScrollArea = ""
    End If
    PreventSleepMode = True
    With Application.CommandBars.FindControl(ID:=2040&)
        .Enabled = Not .Enabled
    End With

End Sub

Private Sub OListBox_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Set ObjUnderCursor = Application.CommandBars
    Call ObjUnderCursor_OnUpdate
    With Sheets(SHEET_NAME)
        If Application.CommandBars.GetEnabledMso("Font") Then
            .ScrollArea = ActiveWindow.VisibleRange.Address
        Else
            .ScrollArea = ""
        End If
    End With
End Sub

Private Property Let PreventSleepMode(ByVal bPrevent As Boolean)
    Const ES_SYSTEM_REQUIRED As Long = &H1
    Const ES_DISPLAY_REQUIRED As Long = &H2
    Const ES_AWAYMODE_REQUIRED = &H40
    Const ES_CONTINUOUS As Long = &H80000000

    If bPrevent Then
        Call SetThreadExecutionState( _
             ES_CONTINUOUS Or ES_DISPLAY_REQUIRED Or ES_SYSTEM_REQUIRED Or ES_AWAYMODE_REQUIRED)
    Else
        Call SetThreadExecutionState(ES_CONTINUOUS)
    End If
End Property

 

[bulletcss]

See if this workaround works for you ?

Place this code in the module of the worksheet in which the ListBox is located:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Me.ScrollArea <> "" Then
        Me.ScrollArea = ""
    End If
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.ScrollArea = ActiveWindow.VisibleRange.Address
End Sub

I came up with following

Global ScreenPos as Integer

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ScreenPos = ActiveWindow.ScrollRow
End Sub

Private Sub ListBox1_GotFocus()
    ActiveWindow.ScrollRow = ScreenPos
End Sub

However, I think your solution is significantly better because it prevents scrolling at all. The reason why I can't implement it is "WorkSheet_SelectionChange" event. The code you put there must be put somewhere else, because user must click on worksheet's cell to reset scrolling limitation. It's not intuitive and therefore not user-friendly.
Is there any other events instead of "SelectionChange" to put there your code?