VBA - close/unwrap/retract a combobox list?

2020-08-09 04:29发布

问题:

I'm working on a dynamically filled Excel combobox (embeded in worksheet)

But sometimes when I update the list inside while it's already "dropdown/unwrap", the display gets crazy.

As I fill and check the list, I use these :

  1. to adjust the number of visible lines

    If .ListCount > 14 Then
        .ListRows = 15
    Else
        .ListRows = .ListCount + 1
    End If
    
  2. to display/unwrap the list (anyCB is an Object parameter in my Sub)

    anyCB.DropDown
    

But sometimes, there is still 15 visible lines but a litlle slider inside the big (15) one, to scroll through all the lines in a single one... :/

So I'm wondering if there is any way to close/unwrap/retract the list before changing the number of visible lines. On any other workaround (lost focus, ...) that you could suggest ;)


Here are screenshots of both strange cases that I've got :

What should reproduce on a regular combobox :

    For i = 0 To 100
        anyCB.AddItem (i)
    Next i

    With anyCB
        If .ListCount > 14 Then
            .ListRows = 15
        Else
            .ListRows = .ListCount + 1
        End If
    End With
    anyCB.DropDown

    If .ListCount > 0 Then
        For i = .ListCount - 1 To 0 Step -1
            .RemoveItem i
        Next i
    End If
    For i = 0 To 100
        anyCB.AddItem (i)
    Next i
    anyCB.DropDown

回答1:

This is a bug. There are two ways you can take care of this

WAY 1

Store the values in an array and then bind the array to the combobox

Option Explicit

Sub Sample()
    Dim i As Long
    Dim MyAr(100)

    anyCB.Clear

    With anyCB
        '~~> This is required because if you run this
        '~~> procedure for the 2nd time with the dropdown
        '~~> visible then you will face the problem again
        .Activate

        For i = 0 To 100
            MyAr(i) = i
        Next i

        .List = MyAr
        DoEvents
        .DropDown
    End With
End Sub 


WAY 2

  1. Call .DropDown
  2. Select a Cell (Sheeesh!!!)
  3. Call .DropDown again

For example

Option Explicit

Sub Sample()
    Dim i As Long

    anyCB.Clear

    With anyCB
        For i = 0 To 100
            .AddItem (i)
        Next i

        If .ListCount > 14 Then
            .ListRows = 15
        Else
            .ListRows = .ListCount + 1
        End If

        .DropDown

        If .ListCount > 0 Then
            For i = .ListCount - 1 To 0 Step -1
                .RemoveItem i
            Next i
        End If

        For i = 0 To 100
            .AddItem (i)
        Next i

        .Activate
        .DropDown
        [A1].Activate
        .DropDown
    End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Not Application.Intersect(Target, Me.Range("A1")) Is Nothing Then
        Application.EnableEvents = False
        '~~> Change the selection to another cell, so that it'll work multiple times
        Me.Range("A2").Activate
        Application.EnableEvents = True
        DoEvents
        anyCB.Activate
        Exit Sub
    End If
End Sub



回答2:

Is this by any chance similar to what you are seeing?

As you already mentioned, the solution is to remove the Focus from the ComboBox before adding items and adjusting its ListRows.

Try to call the following before adding items and changing the .ListRows

anyButton.SetFocus

and once you adjusted the .ListRows you may call

anyCB.DropDown

Complete code example

anyButton.SetFocus
For i = 0 To 100
    anyCB.AddItem (i)
Next i

With anyCB
    If .ListCount > 14 Then
        .ListRows = 15
    Else
        .ListRows = .ListCount + 1
    End If
End With
anyCB.DropDown