ExcelActiveX組合框不顯示選擇

我正在使用一個ActiveX組合框來顯示所有或某些作業表。除此之外，在同一個作業表上，我有一些表單控制元件復選框，用戶可以把它們作為組合框的過濾器。例如，每個復選框都有部門的名稱，所以當一個復選框被選中時，串列將被更新為與該名稱相關的作業表。這很好。

但是，我遇到的問題是，如果我從組合框的下拉串列中選擇一個選項，它不會出現在組合框的欄位中。

以下是我目前正在使用的代碼。

Private Sub TransferList_DropButtonClick()
    Application.EnableEvents = False
    Dim ws As 作業表

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

結束 子

我做了一些研究，我確實發現，通過使用TransferList_Change，問題得到了解決，但過濾功能沒有發揮作用（無論復選框是True還是False都沒有變化）。

我錯過了什么？

謝謝。

歡呼吧。

uj5u.com熱心網友回復：

就像我在評論中說的，我將在幾分鐘內離開。請嘗試理解下一個作業方式，并根據你的情況進行推斷。如果有什么不清楚的地方，請不要猶豫地問。但我只有在幾個小時后才能回答，那時我將在家里。

1. 打開一個新的作業簿，將其保存為 "xlxm"，以接受宏。

3. 在作業表上放置一個組合框（ActiveX 型別）和與作業簿張數相同的表格型別復選框。將它們的名字（名稱和標題）與作業表完全一樣，或者以一種方式使它們與一個或多個作業表相匹配。將組合框命名為 "TransferList".

   。

4. 在標準模塊中復制下一段代碼：

Sub LoadSheets_Combo()
     Dim ws As Worksheet, cmb As MSForms.ComboBox
     Set cmb = ActiveSheet.OLEObjects("TransferList").Object。
     cmb.Clear
     For Each ws In Sheets
            IfActiveSheet.Shapes(ws.Name).ControlFormat.Value = 1 Then
                cmb.AddItem ws.Name
            End If
     下一步 下一步
結束 子

4. 右鍵點擊每個復選框，選擇Assign macro...并選擇'Maros in: 這個作業簿并在'宏名稱'處選擇LoadSheets_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()
     ReDim arrDep(ActiveSheet.CheckBoxes.Count - 1) 。ReDim arrProd(ActiveSheet.CheckBoxes.Count - 1) 。
     For Each chB In ActiveSheet.CheckBoxes
        If Mid(chB. Name, 9, 2) = "De"  Then
            如果 chB.Value = 1 然后
                arrDep(iD) = chB.Name: iD = iD   1
            End If
        End If
        If Mid(chB. Name, 9, 2) = "Pr" Then
            如果 chB.Value = 1 然后
                arrProd(iP) = chB.Name: iP = iP   1
            End If
        End If
     下一步 下一步
     If iD > 0 Then ReDim Preserve arrDep(iD - 1)
     If iP > 0 Then ReDim Preserve arrProd（iP - 1)
     Set cmb = ActiveSheet.OLEObjects("TransferList").Object。
     cmb.Clear
     For Each ws In Sheets
         If iD >0 Then
            mtch = Application.Match("CheckBox" & Mid(ws.Name, 9, 3), arrDep, 0)
            如果 不是 IsError(mtch) 然后
                If cmb.ListCount > 0 然后
                    arrL = cmb.List
                    ReDim Preserve arrL(0 To cmb. ListCount - 1, 0 To 0)
                    mtch = Application.Match(ws.Name, arrL, 0)
                    If IsError(mtch) 然后
                        cmb.AddItem ws.Name
                    End If
                Else If
                    cmb.AddItem ws.Name
                End If
            結束 If
        End If
        '檢查產品 chkB:
         If iP >0 Then
            mtch = Application.Match("CheckBox" & Right(ws.Name, 3), arrProd, 0)
            如果 不是 IsError(mtch) 然后
                If cmb.ListCount > 0 然后
                    arrL = cmb.List
                    ReDim Preserve arrL(0 To cmb. ListCount - 1, 0 To 0)
                    mtch = Application.Match(ws.Name, arrL, 0)
                    If IsError(mtch) 然后
                        cmb.AddItem ws.Name
                    End If
                Else If
                    cmb.AddItem ws.Name
                End If
            結束 If
        結束 若
     下一步 下一步
結束 子

現在沒有時間去評論它。我在別人的筆記本電腦上作業......

標籤：

上一篇：帶有WHEREAND的SQLSELECTQUERY不作業

下一篇：多個將被使用的@ConditionalOnMissingBeanbean