何度も登場する似たような箇所を纏めてみる

先日は、リストボックスで選択したチェックボックス（フォームコントロール）と同グループに属すものを、一括で選択することに挑戦した。
infoment.hatenablog.com

今日は、次の段階に進む前に、何度も登場する似たような箇所を纏めてみる。

何度も登場するのは、以下の処理だ。

1. リストボックスの項目を一つずつ確認するループ
2. チェックボックスの着色

ただし、その時々によって、少しずつ微妙に処理が異なる。

そこでまず、チェックボックスの着色や透明度を変数に入れて、一括で変更できるようにした。

ユーザーフォーム（CBsEditForm）

' チェックボックスの選択色。
Private Const SelectedColor As Long = vbRed
' チェックボックス選択色の透明度。
' ※１＝100％で完全な透明になる。
Private Const SelectedTransparency As Double = 0.7

また、似たような操作を４つに分類し、そのうちの３つを引数として渡すための列挙体を設定した。
※１以上の値は、具体的なグループ番号と見なす。従って、下記は-10から-1の間で値を設定している。

Enum SelectType
    SelectAll = -10
    DeselectAll
    ListSelect
    [_eLast]
End Enum

ちなみに[_eLast]は、↓こちらで学習した。最近のマイブーム（死語？）。
reime.hatenadiary.jp

上記Enumを引数として、新たに作成したのがこちら。

Private Sub SelectSameGroup(group_number As SelectType)
    
    ' 基本的には、引数と同じグループ番号のチェックボックスを選択する。
    ' ただし、SelectTypeが指定された場合に限り、特別な処理を行う。
    Dim i As Long
    
    ' 複数選択可に切り替え。
    
    Select Case group_number
    
        ' チェックボックスを全て選択。
        Case SelectType.SelectAll
            For i = 0 To CBsListBox.ListCount - 1
                CBsListBox.Selected(i) = True
                CBs.Item(i + 1).Interior.Color = SelectedColor
                CBs.Item(i + 1).ShapeRange.Fill.Transparency = SelectedTransparency
            Next
        
        ' チェックボックスを全て選択解除。
        Case SelectType.DeselectAll
            For i = 1 To CBs.Count
                CBsListBox.Selected(i) = False
                CBs.Item(i).Interior.Color = xlNone
            Next
            
        ' リストボックスで選択されたチェックボックスだけを選択。
        Case SelectType.ListSelect
            For i = 0 To CBsListBox.ListCount - 1
                With CBs.Item(i + 1)
                    If CBsListBox.Selected(i) Then
                        .Interior.Color = SelectedColor
                        .ShapeRange.Fill.Transparency = SelectedTransparency
                    Else
                        .Interior.Color = xlNone
                    End If
                End With
            Next
        
        ' 具体的なグループ番号が指定された場合。
        ' 指定グループ番号のチェックボックスを選択する。
        Case Else
            If group_number <> 0 Then
                For i = 0 To CBsListBox.ListCount - 1
                    If CBsListBox.List(i, 2) = group_number Then
                        CBsListBox.Selected(i) = True
                        CBs.Item(i + 1).Interior.Color = SelectedColor
                        CBs.Item(i + 1).ShapeRange.Fill.Transparency = SelectedTransparency
                    Else
                        CBsListBox.Selected(i) = False
                        CBs.Item(i + 1).Interior.Color = xlNone
                    End If
                Next
            End If
    End Select
End Sub

これにより、その他の部分はそれなりにシンプルになった。

Private Sub GroupNumberComboBox_Change()
    Dim SelectedGroupNumber As Long
        ' コンボボックスで選択したグループ番号（文字列）を、
        ' 変数に一旦格納する。
        ' ※この後、複数選択可否の切り替えで、コンボボックスの表示が
        ' 　初期化されてしまうため、現時点で退避させている。
        If GroupNumberComboBox.Value <> vbNullString Then
            SelectedGroupNumber = CLng(GroupNumberComboBox.Value)
        Else
            Exit Sub
        End If
    
        MultiSelectCheck.Value = True
        ' 選択したグループ番号と同じチェックボックスのみ選択。
        SelectSameGroup SelectedGroupNumber  ' <---------------ここ

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

Private Sub GroupSelectButton_Click()
    Dim GroupNumber As Long
        On Error Resume Next
        GroupNumber = CBsListBox.List(CBsListBox.ListIndex, 2)
        
        ' グループに属していない場合、処理中断。
        If GroupNumber = 0 Then Exit Sub
        
        ' グループに属するボタンをすべて選択するために、
        ' リストボックスを複数選択可に切り替える。
        MultiSelectCheck.Value = True
        
        ' グループ番号が同じものを全て選択
        SelectSameGroup GroupNumber  ' <---------------ここ
End Sub

' 全選択と全解除を、ボタンを押すたびに切り替える。
Private Sub SelectAllButton_Click()
    Select Case SelectAllButton.Caption
        ' 全選択ボタンの場合。
        Case "全選択"
            MultiSelectCheck.Value = True
            SelectSameGroup SelectAll  ' <---------------ここ
            SelectAllButton.Caption = "全解除"
            
        ' 全解除ボタンの場合。
        Case "全解除"
            ResetCBsListBox
            SelectAllButton.Caption = "全選択"
    End Select
End Sub

Private Sub ResetCBsListBox()
    CBsListBox.Clear
    CBsListBox.List = CheckBoxList
    GroupNumberComboBox.List = GroupList
    GroupNumberComboBox.Value = vbNullString
    SelectSameGroup DeselectAll  ' <---------------ここ
End Sub

テスト結果は良好。ただし動画としては昨日と同じになるため、今日は割愛する。

明日に続きます。

参考まで。