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 还是 [=14= 都没有变化） ]).

我错过了什么？

干杯。

Answer 1

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

打开一个新工作簿并将其另存为“xlxm”，以接受宏。
在工作 sheet 上放置一个组合框（ActiveX 类型）和许多表单类型复选框作为工作簿编号 sheet。将它们命名（名称和标题）与 sheet 完全相同，或者以一种使它们与一个或多个 sheet 匹配的方式命名。将组合命名为“TransferList”。
复制标准模块中的下一个代码：

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

右键单击每个复选框并选择 Assign macro... 并选择“Maros in: This workbookand at 'Macro name' chooseLoadSheets_Combo”。
开始使用复选框值支付并查看组合是如何加载的，只有 sheets 与 ticked 匹配（以某种方式）复选框。

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

已编辑:

请尝试下一个代码（我理解）您的案例所需的代码：

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当sheet被激活时，请将下一个代码事件复制到sheet 保留控制代码模块：

Option Explicit


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

Excel ActiveX 组合框未显示选择

Excel ActiveX Combo Box not Showing Selection

excel

vba

combobox