VBA - 循环选项按钮＆amp;用户窗体上的复选框

Question

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

用户表单上有一个命令按钮 - Next - 获取用户首选项（选择了选项按钮），打开新工作簿，并在特定工作簿中显示所需数据（选中复选框）。

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

如何在用户窗体上循环选项按钮和复选框，并捕获哪些是＆＃34;已选择＆＃34;？

所选复选框中显示的数据（在工作表中）取决于所选的选项按钮，例如：如果我选择了财务（选项按钮），然后我选择了照片和视频（复选框），我想在相应的工作表上显示特定于这些选择的数据。

这是我到目前为止所做的：

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

这是userform：

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是一种事件驱动的语言，这意味着您可以捕获用户与您的程序进行的大多数交互。这样就不再需要每次循环控件，因为您可以根据用户的选择记录选择。

最明显的事情是创建某种工作表/范围地图，例如在Collection中，然后根据选择key检索所需的对象。下面的代码是你如何做到的一个框架 - 显然你需要扩展和调整它以满足你自己的需要。

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

Option Explicit

Private mRangeMap As Collection
Private mOptKey As String
Private mCboxKey As String

然后构建你的地图。在下面的示例中，我已在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

现在您只需要代码来存储用户输入。我只有3个选项按钮和2个复选框，例如：

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

最后，当用户点击“下一步”按钮时复制数据：

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的评论更新

下面是更新的代码，它会迭代您的复选框选择。如果您希望按特定顺序添加其他代码，则需要添加其他代码：

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