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规则加载组合当工作表被激活，请复制保持控件代码模块的工作表中的下一个代码事件:

Option Explicit

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