VBA - ループオプションボタン＆ユーザーフォーム

Question

上のボックスをチェックしてください私は、ユーザーフォームを使用して特定のワークシート内の特定のデータを表示しようとしています。

ユーザーフォーム（オプションボタンが選択されている）、新しいブックが開き、特定のブックに選択されたデータ（チェックボックスが選択されている）が表示されます。

6つのオプションボタンと6つのチェックボックスがあります。開いたワークシートは、オプションボタンのプリファレンスに基づいており、チェックボックスで選択した内容に応じて、そのトピックに関連付けられたデータがワークシートに表示されます。

どうすればループオプションボタンと「選択」しているユーザーフォームとキャプチャにチェックボックスをオンにしますか？選択されたチェックボックスから（ワークシートで）表示

データは、例えば、選択されたオプションボタンに依存します私は金融（オプションボタン）を選んだ、と私は（チェックボックスをオン）写真とビデオを選択した場合、私は、適切なワークシート上のものの選択に固有のデータを表示したいと思います。ここで

は、私がこれまで持っているものである：ここでは

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

はい、それはあなたがやろうとしてどのような少しは不明だ...続き はどのように一般的な例です。チェックボックスとの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

は、あなたが望むものを正確に確認することが少し難しいですが、私はあなたがWROで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 

は今、あなただけのユーザー入力を保存するためのコードが必要になります。ユーザーが[次へ]ボタンに当たったとき、最後に

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 

、データをコピーします：私はちょうど例えば3つのオプションボタンと2つのチェックボックスを持っている

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