工作表中的 Active X 组合框

Question

我在 ComboBox1 的工作表中使用 Active X ComboBox，我列出了工作正常的工作表名称。

我尝试根据在 ComboBox1 中选择的工作表在 ComboBox2 中添加数据。

如果我从下拉列表中选择 ComboBox1 中的工作表名称，那么 ComboBox2 需要自动填充所选工作表中的数据，一旦我单击命令按钮 ComboBox1 中的工作表和 ComboBox2 中的详细信息需要同时选择。请在这个主题上帮助我，这对我开发我的项目更有帮助。

只是我的问题是我需要在 ComboBox1 中选择工作表，并且需要在单击命令按钮后选择 ComboBox2 中的范围，具体工作表和范围需要一次选择。

代码如下：

Private Sub CommandButton1_Click()
Dim sName As String
Dim x As Integer
Dim Range As Range
Dim Sh As Worksheet

   For x = 3 To Sheets.Count
       Sheets(x).Visible = False
   Next x

 sName = ComboBox1.Value

    With ActiveWorkbook.Sheets(sName)
  
        .Visible = True
        .Activate
    End With

End Sub

Private Sub Worksheet_Activate()

Dim Sh As Worksheet
Dim sName As String
Dim x As Integer

Me.ComboBox1.Clear
 For Each Sh In ThisWorkbook.Worksheets

    Me.ComboBox1.AddItem Sh.Name

Next Sh
Exit Sub

End Sub

Private Sub ComboBox2_Change()
Dim Sh As Worksheet
Dim sName As String

sName = ComboBox1.Value

If ComboBox1.Value Then

    Sheets(sName).Activate

    Set Sh = Worksheets("sName")

    If ActiveSheet.Name = Sh.Name Then

        ComboBox2.ListFillRange = "sName"

    Else

       Exit Sub

    End If

End Sub

Answer 1

请尝试下一种方法：

1. 在同一工作表模块中复制下一个事件代码。它将填充 ListBox1：

Private Sub Worksheet_Activate()
  Dim sh As Worksheet
  
  Application.EnableEvents = False
   ActiveSheet.OLEObjects("Listbox1").Object.Clear
   For Each sh In ThisWorkbook.Worksheets
     ActiveSheet.OLEObjects("Listbox1").Object.AddItem sh.Name
   Next
  Application.EnableEvents = True
End Sub

1. 复制下一个代码（ListBox1_Change 事件）。它将填充 ListBox1 中所选工作表的 ListBox2 范围：

Private Sub ListBox1_Change()
    Dim lst1 As MSForms.listBox, lst2 As MSForms.listBox, ws As Worksheet
    Dim lastRow As Long, arrNam As Variant, I As Long, k As Long
    
    Set lst1 = ActiveSheet.OLEObjects("Listbox1").Object
    Set lst2 = ActiveSheet.OLEObjects("Listbox2").Object
    
    If lst1.ListIndex = -1 Then Exit Sub
    Set ws = Worksheets(lst1.Value)
    lastRow = ws.Range("A" & rows.count).End(xlUp).row
    If lastRow = 1 Then
        If ws.Range("A1").Value = "" Then
            MsgBox "Nothing on A:A column of sheet " & ws.Name: Exit Sub
        Else
            With lst2
                .Clear
                .ColumnCount = 2
                .AddItem ws.Range("A1").Value
                .list(0, 1) = 1
            End With
            Exit Sub
        End If
    End If
    ReDim arrNam(1 To 2, 1 To lastRow)
    For I = 1 To lastRow
        If ws.Range("A" & I).Value <> "" Then
            k = k + 1
            arrNam(1, k) = ws.Range("A" & I).Value
            arrNam(2, k) = I 'the row to be selected
        End If
    Next
    ReDim Preserve arrNam(1 To 2, 1 To k)
    With lst2
        .ListFillRange = ""
        .ColumnWidths = "100;0"
        .Clear
        .ColumnCount = 2 ' Worksheets(lst1.Value).Range(rngAddress).Columns.count
        .list = Application.Transpose(arrNam)
    End With
End Sub

1. 在同一工作表模块中复制下一个Sub 代码。它将从列表框 1 中选择的工作表中选择列表框 2 的所有范围：

Sub SelectSheetNames()
  Dim lst1 As MSForms.listBox, lst2 As MSForms.listBox, i As Long
  Dim rngUnion As Range
    
    Set lst1 = ActiveSheet.OLEObjects("Listbox1").Object
    Set lst2 = ActiveSheet.OLEObjects("Listbox2").Object
    Worksheets(lst1.Value).Activate
    For i = 0 To lst2.ListCount - 1
        If rngUnion Is Nothing Then
            Set rngUnion = Worksheets(lst1.Value).Range("A" & lst2.list(i, 1))
        Else
            Set rngUnion = Union(rngUnion, Worksheets(lst1.Value).Range("A" & lst2.list(i, 1)))
        End If
    Next i
    rngUnion.Select
End Sub

上面的Sub可以从Button点击事件中调用...

重新编辑：

我认为您将需要下一个 listBox2 Change 事件。请复制同一工作表模块中的下一个代码：

Private Sub ListBox2_Change()
   Dim ws As Worksheet, lst1 As MSForms.listBox, lst2 As MSForms.listBox
   
   Set lst1 = ActiveSheet.OLEObjects("Listbox1").Object
   Set lst2 = ActiveSheet.OLEObjects("Listbox2").Object
   Set ws = Worksheets(lst1.Value)
   If lst2.ListIndex = -1 Then Exit Sub
   MsgBox ws.Range("B" & lst2.list(lst2.ListIndex, 1))
End Sub

以上代码将在 MsgBox 中显示您在列表框中选择的名称的 B:B 列的内容...

请测试一下并发送一些反馈。