同じグループのCheckBox（フォームコントロール）を全て選択する。

昨日は、リストボックスで選択した任意のチェックボックス（フォームコントロール）でグループを作成し、一つしか選択できないようにしてみた。
infoment.hatenablog.com

今日は、リストボックスで選択したチェックボックスと同グループに属すものを、一括で選択してみる。
f:id:Infoment:20191114224246p:plain

繰り返しになるが、最初に断っておく。以下の方法は、オプションボタンを用いれば何の問題もなく実現可能だ。従って本来、このような方法は取るべきでない。
既存書式を変更不可の場合であって、さらに自動化などを図りたいなどの特別な場合に使用を限定した方が良いと思う。

さて今回は、二つの方法でグループを選択してみる。

リストボックスで選択したチェックボックスと同じグループのものを全て選択
選択したグループ番号と同じチェックボックスを全て選択

そのために、ユーザーフォームにはコマンドボタンとコンボボックスを一つずつ
準備した。
f:id:Infoment:20191114225135p:plain

コマンドボタン　GroupSelectButton
コンボボックス　GroupNumberComboBox

※明日以降、コードの内容が変わることもあると思うので、今回もテスト結果だけご覧いただければと思う。

まず、同じグループを選択するために、グループ番号は取得しやすい場所にあった方が良い。ということでチェックリストボックスの３列目に、グループ番号を置くことにした。

標準モジュール

Public Property Get CheckBoxList() As Variant
    Dim arr() As Variant
        If CBs.Count = 0 Then
            CheckBoxList = Array()
            Exit Property
        Else
            ReDim arr(1 To CBs.Count, 1 To 3)
        End If
    Dim i
        On Error Resume Next
        For i = 1 To CBs.Count
            arr(i, 1) = CBs.Item(i).Name
            arr(i, 2) = CBs.Item(i).Caption
            
            ' 今回追加。
            arr(i, 3) = CLng(Split(CBs.Item(i).Name, "_")(1))
        Next
        On Error GoTo 0
        CheckBoxList = arr
End Property

リストは３列にしたものの、リストボックスの列数は２列のままとしている。グループ番号は表示する必要が無いので、リストボックスから食み出させている。

ユーザーフォーム（CBsEditForm）

ボタンを押した際のイベントがこちら。選択中のチェックボックスと同じグループのものを選ぶだけなので、さほど難しくない。

Private Sub GroupSelectButton_Click()
    Dim GroupNumber As Long
        GroupNumber = CBsListBox.List(CBsListBox.ListIndex, 2)
        
        ' グループに属していない場合、処理中断。
        If GroupNumber = 0 Then Exit Sub
        
        ' グループに属するボタンをすべて選択するために、
        ' リストボックスを複数選択可に切り替える。
        MultiSelectCheck.Value = True

        ' グループ番号が同じものを全て選択
    Dim i As Long
        For i = 0 To CBsListBox.ListCount - 1
            If CBsListBox.List(i, 2) = GroupNumber Then
                CBsListBox.Selected(i) = True
                CBs.Item(i + 1).Interior.Color = vbRed
                CBs.Item(i + 1).ShapeRange.Fill.Transparency = 0.7
            Else
                CBsListBox.Selected(i) = False
                CBs.Item(i + 1).Interior.Color = xlNone
            End If
        Next
End Sub

続いて、コンボボックスについて。まずグループ番号を取得して、配列に格納することとした。そこで、同配列をソートするためのマクロを準備する。

標準モジュール

Public Function SortArray(ByVal arr As Variant, _
                       Optional sort_order As Excel.XlSortOrder = xlAscending) As Variant
    Dim aryList As Object
    Dim s As Variant
    Set aryList = CreateObject("System.Collections.ArrayList")
    
    For Each s In arr
        Call aryList.Add(s)
    Next
    
    Select Case sort_order
        Case xlAscending
            ' 昇順でソート。
            Call aryList.Sort
        Case xlDescending
            ' 昇順でソートののち、降順へ反転。
            Call aryList.Sort
            Call aryList.Reverse
    End Select
    
    SortArray = aryList.ToArray
End Function

ユーザーフォーム（CBsEditForm）

コンボボックスの切り替えも、先程と同様の手順で行う。

Private Sub GroupNumberComboBox_Change()
    Dim SelectedGroupNumber As Long
        ' コンボボックスで選択したグループ番号（文字列）を、
        ' 変数に一旦格納する。
        ' ※この後、複数選択可否の切り替えで、コンボボックスの表示が
        ' 　初期化されてしまうため、現時点で退避させている。
        If GroupNumberComboBox.Value <> vbNullString Then
            SelectedGroupNumber = CLng(GroupNumberComboBox.Value)
        Else
            Exit Sub
        End If
        
    Dim i As Long
    
        ' 選択したグループ番号と同じチェックボックスのみ選択。
        If SelectedGroupNumber <> 0 Then
            MultiSelectCheck = True
            For i = 0 To CBsListBox.ListCount - 1
                If CBsListBox.List(i, 2) = SelectedGroupNumber Then
                    CBsListBox.Selected(i) = True
                    CBs.Item(i + 1).Interior.Color = vbRed
                    CBs.Item(i + 1).ShapeRange.Fill.Transparency = 0.7
                Else
                    CBsListBox.Selected(i) = False
                    CBs.Item(i + 1).Interior.Color = xlNone
                End If
            Next
        End If

        ' コンボボックスに、グループ番号を返して表示させる。
        ' 無限ループにならないよう、イベントは一時手停止。
        Application.EnableEvents = False
        GroupNumberComboBox.Value = SelectedGroupNumber
        Application.EnableEvents = True
End Sub

コンボボックスに充てるためのリストがこちら。
辞書（連想配列）の特性（キーを重複登録できない）を利用して、グループ番号の重複を除去している。

Private Property Get GroupList() As Variant
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    Dim i As Long
        For i = 0 To CBsListBox.ListCount - 1
            If IsNumeric(CBsListBox.List(i, 2)) Then
                Dict(CBsListBox.List(i, 2)) = i
            End If
        Next
    Dim arr As Variant
        arr = Dict.keys
        
        GroupList = SortArray(arr)
End Property

コンボボックスもリセットする場合があるので、リセットマクロに反映。

Private Sub ResetCBsListBox()
    CBsListBox.Clear
    CBsListBox.List = CheckBoxList
    GroupNumberComboBox.List = GroupList
    GroupNumberComboBox.Value = vbNullString
    Dim i As Long
        For i = 1 To CBs.Count
            CBs.Item(i).Interior.Color = xlNone
        Next
End Sub