VBA - 关闭/展开/收回组合框列表？

Question

我正在处理动态填充的 Excel 组合框（嵌入在工作表中）

但有时当我更新里面的列表时它已经“下拉/展开”，显示会变得疯狂。

当我填写并检查列表时，我使用这些：

1. 调整可见行数

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

2. 显示/展开列表（anyCB 是我的 Sub 中的 Object 参数）

   anyCB.DropDown
   

但有时，仍然有 15 条可见的行，但在大 (15) 行内有一个小滑块，可以在一个行中滚动所有行...：/

所以我想知道在更改可见行数之前是否有任何方法可以关闭/展开/收回列表。关于您可以建议的任何其他解决方法（失去焦点，...）；）

---

以下是我得到的两个奇怪案例的屏幕截图：

应该在常规组合框上重现什么：

    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

Answer 1

这是一个错误。有两种方法可以解决这个问题

方式一

将值存储在数组中，然后将数组绑定到组合框

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 

方式2

1. 称呼 .DropDown
2. 选择一个单元格（Sheeesh!!!）
3. .DropDown再打电话

例如

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