Excel ActiveX 组合框不显示选择

Question

我正在使用 ActiveX 组合框来显示所有或部分工作表。除此之外，在同一个工作表上，我有一些表单控件复选框，用户可以将它们用作组合框的过滤器。例如，每个复选框都有部门的名称，因此检查一个列表时，将使用与该名称相关的工作表进行更新。效果很好。

但是，我遇到的问题是，如果我确实从组合框下拉列表中选择了一个选项，它不会出现在组合框的字段中。

这是我目前正在使用的代码。

Private Sub TransferList_DropButtonClick()
    Application.EnableEvents = False
    Dim ws As Worksheet

    I = 1
    TransferList.Clear
    For Each ws In Sheets
        If ActiveSheet.Shapes("CheckBox_Viva").ControlFormat.Value = 1 Then
            TransferList.AddItem ws.Name
            I = I + 1
        End If
    Next ws
    
    Application.EnableEvents = True

End Sub

我做了一些研究，发现使用TransferList_Change 解决了问题，但过滤不起作用（无论复选框是True 还是False，都没有变化）。

我错过了什么？

干杯。

Answer 1

就像我在评论中所说的，我会在几分钟后离开。请尝试了解下一种工作方式并根据您的情况进行推断。如果有不清楚的地方，请不要犹豫。但我只能在几个小时后才能回答，那时我会在家。

1. 打开一个新工作簿并将其保存为“xlxm”，以接受宏。

2. 在工作表上放置一个组合框（ActiveX 类型）和许多表单类型复选框作为工作簿的工作表数。将它们（名称和标题）完全命名为工作表，或者以使它们与一张或多张工作表匹配的方式命名。将组合命名为“TransferList”。

3. 复制标准模块中的下一个代码：

Sub LoadSheets_Combo()
     Dim ws As Worksheet, cmb As MSForms.ComboBox
     Set cmb = ActiveSheet.OLEObjects("TransferList").Object
     cmb.Clear
     For Each ws In Sheets
            If ActiveSheet.Shapes(ws.Name).ControlFormat.Value = 1 Then
                cmb.AddItem ws.Name
            End If
     Next
End Sub

4. 右键单击每个复选框并选择 Assign macro... 并选择“Maros in: This workbookand at 'Macro name' chooseLoadSheets_Combo`。

5. 使用复选框值开始付款并查看组合是如何加载的，只有与（以某种方式）与勾选复选框匹配的工作表。

测试上述建议的场景并发送一些反馈...

已编辑：

请尝试下一个能够为您的案例做（我理解）您需要的代码：

Option Explicit

Sub LoadSheets_Combo()
     Dim ws As Worksheet, cmb As MSForms.ComboBox, strDep As String, strProd As String, arrDep, arrProd
     Dim chB As CheckBox, iD As Long, iP As Long, mtch, arrL(), boolAllFalse As Boolean
     
     'ReDim the arrays keeping departments and products at their maximum possible size:
     ReDim arrDep(ActiveSheet.CheckBoxes.Count - 1): ReDim arrProd(ActiveSheet.CheckBoxes.Count - 1):
     For Each chB In ActiveSheet.CheckBoxes  'iterate between check boxes:
        If Mid(chB.Name, 9, 2) = "De" Then     'if a check box refers a department name:
            If chB.Value = 1 Then                   'if its value is True:
                arrDep(iD) = chB.Name: iD = iD + 1 'put it in the departments array
            End If
        End If
        If Mid(chB.Name, 9, 2) = "Pr" Then    'if a check box refers a product name:
            If chB.Value = 1 Then                 'if its value is True:
                arrProd(iP) = chB.Name: iP = iP + 1 'put it in the products array
            End If
        End If
     Next
     If iD > 0 Then ReDim Preserve arrDep(iD - 1) 'redim the array preserving only the loaded elements
     If iP > 0 Then ReDim Preserve arrProd(iP - 1) 'redim the array preserving only the loaded elements
     Set cmb = ActiveSheet.OLEObjects("TransferList").Object 'set the combo to be loaded
     cmb.Clear                                                'clear the combo items
     boolAllFalse = onlyFalseChkB   'check if all check boxes value is False and place the result in a boolean var
     For Each ws In Sheets                              'iterate between all sehets
        If boolAllFalse Then                              'if all checkboxes value are False:
            cmb.AddItem ws.Name                      'add the sheet name in the combo
        Else                                                   'if not all check boxes value are False:
            If iD > 0 Then                                 'if there are department check boxes in departments array:
               mtch = Application.Match("CheckBox" & Mid(ws.Name, 9, 3), arrDep, 0) 'check if the sheet is found in the array
               If Not IsError(mtch) Then               'if found
                   If cmb.ListCount > 0 Then          'if there are items in the combo
                       arrL = cmb.List                     'extract the combo items in an array a 2D array with 10 columns (fastest way)
                       ReDim Preserve arrL(0 To cmb.ListCount - 1, 0 To 0) 'replace all (Null) values from columns 1 to 10)
                       mtch = Application.Match(ws.Name, arrL, 0)             'check if the sheet name is already added in the combo
                       If IsError(mtch) Then            'if not added:
                           cmb.AddItem ws.Name      'add it
                       End If
                   Else
                       cmb.AddItem ws.Name          'add the sheet name in the combo, if combo does not have any item (yet)
                   End If
               End If
           End If
           'check products chkB:
            If iP > 0 Then                               'proceed in the same way for the products check boxes array:
               mtch = Application.Match("CheckBox" & Right(ws.Name, 3), arrProd, 0)
               If Not IsError(mtch) Then
                   If cmb.ListCount > 0 Then
                       arrL = cmb.List
                       ReDim Preserve arrL(0 To cmb.ListCount - 1, 0 To 0)
                       mtch = Application.Match(ws.Name, arrL, 0)
                       If IsError(mtch) Then
                           cmb.AddItem ws.Name
                       End If
                   Else
                       cmb.AddItem ws.Name
                   End If
               End If
           End If
        End If
    Next
End Sub
Function onlyFalseChkB() As Boolean
    Dim chB As CheckBox
    For Each chB In ActiveSheet.CheckBoxes
        If chB.Value = 1 Then Exit Function
    Next
    onlyFalseChkB = True
End Function

为了按照上述Sub规则加载combo当表单被激活时，请复制表单中的下一个代码事件，保留控件代码模块：

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    LoadSheets_Combo
End Sub