VBA – 循环选项button和用户窗体上的checkbox

我正在尝试使用用户窗体在特定的工作表中显示特定的数据。

用户表单上有一个命令button – Next – 用户首选项（select选项button），打开一个新的工作簿，并在特定的工作簿中显示所需的数据（选中的checkbox）。

有6个选项button和6个checkbox。 打开的工作表基于选项button首选项，根据checkbox中select的内容，与该主题关联的数据将显示在工作表中。

我如何循环选项button和用户窗体上的checkbox，并捕获哪些“选定”？

从选定的checkbox中显示（在工作表中）的数据取决于select的选项button，例如，如果我select金融（选项button），然后我select照片和video（checkbox），我想要显示的数据那些在适当的工作表上的select。

这是我到目前为止：

 Private Sub cmdNext_Click() 'declare variables Dim strFinancial As String, strFamily As String, strSadness As String, strSchool As String, strRelationship As String, strTime As String Dim shtFinancial As Worksheet, shtFamily As Worksheet, shtSadness As Worksheet, shtSchool As Worksheet, shtRelationship As Worksheet, shtTime As Worksheet, shtData As Worksheet shtFinancial = Workbooks("PROJECT.xlsm").Worksheets("Financial") shtTime = Workbooks("PROJECT.xlsm").Worksheets("Time") shtFamily = Workbooks("PROJECT.xlsm").Worksheets("Family") shtSadness = Workbooks("PROJECT.xlsm").Worksheets("Sadness") shtSchool = Workbooks("PROJECT.xlsm").Worksheets("School") shtRelationship = Workbooks("PROJECT.xlsm").Worksheets("Relationship") shtData = Workbooks("PROJECT.xlsm").Worksheets("Data") 'set option button selection to string strFinancial = obFinancial.Value strFamily = obFamily.Value strSadness = obSadness.Value strSchool = obSchool.Value strRelationship = obRelationship.Value strTime = obTime.Value 'activate worksheet of chosen stressor (option button) Select Case True Case strTime = True shtTime.activate Case strFinancial = True shtFinancial.activate Case strFamily = True shtFamily.activate Case strSadness = True shtSadness.activate Case strSchool = True shtSchool.activate Case strRelationship = True shtRelationship.activate End Select 'ADVICE 'loop through checkboxes HOW ???? 'display advice according to option button chosen If obFinancial.Value = True And Me.cbAdvice.Value = True Then shtData.Range("A1:A10").Copy Destination:=Sheets("Financial").Range("A1:A10") End If If obSadness.Value = True And Me.cbAdvice.Value = True Then Sheets("Data").Range("A21:A30").Copy Destination:=Sheets("Sadness").Range("A1:A10") End If If obSchool.Value = True And Me.cbAdvice.Value = True Then Sheets("Data").Range("A31:A40").Copy Destination:=Sheets("School").Range("A1:A10") End If If obRelationship.Value = True And Me.cbAdvice.Value = True Then Sheets("Data").Range("A41:A50").Copy Destination:=Sheets("Relationship").Range("A1:A10") End If If obTime.Value = True And Me.cbAdvice.Value = True Then Sheets("Data").Range("A51:A60").Copy Destination:=Sheets("Time").Range("A1:A10") End If End Sub 

这里是用户表单：

Answer 1

是的，有一点你不清楚你想要做什么…下面是一个通用的例子，你可能会循环CheckBoxes和OptionButtons：

 Private Sub CommandButton1_Click() Dim c As Control, str As String For Each c In UserForm1.Controls If TypeName(c) = "CheckBox" Or TypeName(c) = "OptionButton" Then str = str & IIf(c = True, c.Caption & vbCrLf, "") End If Next c MsgBox "Selected controls" & vbCrLf & str End Sub 

Answer 2

看到你想要的东西有点难，但是我不禁想知道你是否以错误的方式看待VBA。 VBA是一种事件驱动的语言，这意味着您可以捕获用户与您的程序的大部分交互。 这应该消除每次循环访问您的控件的需要，因为您可以在用户进行select时logging日志。

最明显的做法是创build某种表单/范围映射，比如在一个Collection ，然后根据selectkey检索你想要的对象。 下面的代码是如何做到这一点的骨架 – 显然你需要扩展和调整，以适应自己的需要。

首先在模块级声明一些variables（即页面顶部）：

 Option Explicit Private mRangeMap As Collection Private mOptKey As String Private mCboxKey As String 

然后build立你的地图。 在下面的例子中，我已经在Userform_Initialize例程中做了这个，但是你可以在任何地方调用它：

 Private Sub UserForm_Initialize() Dim shtRngPair(1) As Object 'Build the range map. Set mRangeMap = New Collection With ThisWorkbook 'use name ofyour workbook Set shtRngPair(0) = .Worksheets("Financial") With .Worksheets("Data") Set shtRngPair(1) = .Range("A1:A10") mRangeMap.Add shtRngPair, "Fin|Adv" Set shtRngPair(1) = .Range("A11:A20") mRangeMap.Add shtRngPair, "Fin|Pho" End With Set shtRngPair(0) = .Worksheets("Sadness") With .Worksheets("Data") Set shtRngPair(1) = .Range("A21:A30") mRangeMap.Add shtRngPair, "Sad|Adv" Set shtRngPair(1) = .Range("A31:A40") mRangeMap.Add shtRngPair, "Sad|Pho" End With Set shtRngPair(0) = .Worksheets("School") With .Worksheets("Data") Set shtRngPair(1) = .Range("A41:A50") mRangeMap.Add shtRngPair, "Sch|Adv" Set shtRngPair(1) = .Range("A51:A60") mRangeMap.Add shtRngPair, "Sch|Pho" End With End With End Sub 

现在你只需要存储用户input的代码。 举个例子，我只有3个选项button和2个checkbox：

 Private Sub cboxAdvice_Click() mCboxKey = "Adv" End Sub Private Sub cboxPhotos_Click() mCboxKey = "Pho" End Sub Private Sub obFinancial_Click() mOptKey = "Fin" End Sub Private Sub obSadness_Click() mOptKey = "Sad" End Sub Private Sub obSchool_Click() mOptKey = "Sch" End Sub 

最后，在用户点击“下一步”button时复制数据：

 Private Sub cmdNext_Click() Dim key As String Dim shtRngPair As Variant Dim v As Variant 'Create the key key = mOptKey & "|" & mCboxKey 'Find the relevant range On Error Resume Next shtRngPair = mRangeMap(key) On Error GoTo 0 'Test if the key is valid If IsEmpty(shtRngPair) Then MsgBox "Selection [" & key & "] is invalid." Exit Sub End If 'Copy the data v = shtRngPair(1).Value2 With shtRngPair(0) .Cells.Clear .Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v .Activate End With End Sub 

根据OP的评论更新

下面是迭代您的checkboxselect更新的代码。 如果您想按特定顺序添加代码，则需要添加其他代码：

 Option Explicit Private mRangeMap As Collection Private mCboxKeys As Collection Private mOptKey As String Private Sub cboxAdvice_Change() UpdateCheckboxList "Adv", cboxAdvice.Value End Sub Private Sub cboxPhotos_Change() UpdateCheckboxList "Pho", cboxPhotos.Value End Sub Private Sub UpdateCheckboxList(ele As String, addItem As Boolean) 'Add or remove the item If addItem Then mCboxKeys.Add ele, ele Else mCboxKeys.Remove ele End If End Sub Private Sub obFinancial_Click() mOptKey = "Fin" End Sub Private Sub obSadness_Click() mOptKey = "Sad" End Sub Private Sub obSchool_Click() mOptKey = "Sch" End Sub Private Sub cmdNext_Click() Dim key As String Dim shtRngPair As Variant, v As Variant, cbk As Variant Dim rng As Range Dim initialised As Boolean For Each cbk In mCboxKeys 'Create the key key = mOptKey & "|" & cbk 'Find the relevant range On Error Resume Next shtRngPair = mRangeMap(key) On Error GoTo 0 If IsEmpty(shtRngPair) Then 'Test if the key is valid MsgBox "Selection [" & key & "] is invalid." Else If Not initialised Then With shtRngPair(0) .Cells.Clear .Activate Set rng = .Range("A1") End With initialised = True End If 'Copy the data v = shtRngPair(1).Value2 rng.Resize(UBound(v, 1), UBound(v, 2)).Value = v 'Offset range Set rng = rng.Offset(UBound(v, 1)) End If Next End Sub Private Sub UserForm_Initialize() Dim shtRngPair(1) As Object 'Initialise the collections Set mRangeMap = New Collection Set mCboxKeys = New Collection 'Build the range map. With ThisWorkbook 'use name ofyour workbook Set shtRngPair(0) = .Worksheets("Financial") With .Worksheets("Data") Set shtRngPair(1) = .Range("A1:A10") mRangeMap.Add shtRngPair, "Fin|Adv" Set shtRngPair(1) = .Range("A11:A20") mRangeMap.Add shtRngPair, "Fin|Pho" End With Set shtRngPair(0) = .Worksheets("Sadness") With .Worksheets("Data") Set shtRngPair(1) = .Range("A21:A30") mRangeMap.Add shtRngPair, "Sad|Adv" Set shtRngPair(1) = .Range("A31:A40") mRangeMap.Add shtRngPair, "Sad|Pho" End With Set shtRngPair(0) = .Worksheets("School") With .Worksheets("Data") Set shtRngPair(1) = .Range("A41:A50") mRangeMap.Add shtRngPair, "Sch|Adv" Set shtRngPair(1) = .Range("A51:A60") mRangeMap.Add shtRngPair, "Sch|Pho" End With End With End Sub