CheckBoxを全部選んで削除する - Infomentのブログ～Excel VBA奮闘記～

昨日は、リストボックスの複数選択可否をチェックボックス（ActiveXコントロール）で操作することで、ユーザーフォーム内のコードをスッキリさせることに挑戦した。
infoment.hatenablog.com

今日は、リストボックスで選択した任意のチェックボックス（フォームコントロール）を削除することに挑戦する。
f:id:Infoment:20191112223923p:plain

今回は、以下のボタンを追加した。

全選択　　SelectAllButton
選択削除　SelectedCBsDeleteButton

なお、全選択ボタンはクリックするたびに、全解除と全選択が交互に入れ替わる。
f:id:Infoment:20191112224148p:plain

作ってみて気になったのは、リストボックス内での選択状況と、シート上での選択状況の不一致だ。選んでいないのに、選択中の色になっているのは具合が悪い。この辺り、かなり丁寧に作りこんでみたが、まだ穴があるかも知れない。

他にも何点か修正した箇所があるので、今日もユーザーフォームモジュール内のコードは全て記載しておく。
※明日以降もまた変わるだろうから、最後のテストだけ見ても良いかも。

Option Explicit

' 全選択と全解除を、ボタンを押すたびに切り替える。
Private Sub SelectAllButton_Click()
    Select Case SelectAllButton.Caption
        ' 全選択ボタンの場合。
        Case "全選択"
            Dim i As Long
                ' 複数選択可に切り替え。
                MultiSelectCheck.Value = True
                For i = 0 To CBsListBox.ListCount - 1
                    CBsListBox.Selected(i) = True
                    CBs.Item(i + 1).Interior.Color = vbRed
                    CBs.Item(i + 1).ShapeRange.Fill.Transparency = 0.7
                Next
                SelectAllButton.Caption = "全解除"
        ' 全解除ボタンの場合。
        Case "全解除"
            ResetCBsListBox
            SelectAllButton.Caption = "全選択"
    End Select
End Sub

Private Sub MultiSelectCheck_Click()
    ' リストボックスの着色解除。
    ResetCBsListBox

    ' リストボックスの複数選択可否を確認。
    Select Case MultiSelectCheck.Value
        ' 選択可の場合。
        Case True
            CBsListBox.MultiSelect = fmMultiSelectMulti
        ' 選択不可の場合。
        Case False
            CBsListBox.MultiSelect = fmMultiSelectSingle
            ' 一つしか選べないのだから、「全解除」は不適当。
            ' ボタンの状態が何であっても、全選択モードに切り替える。
            SelectAllButton.Caption = "全選択"
    End Select
    
    ' 選択可否に合わせて、キャプション変更ボタンの有効無効を切り替え。
    ' ※片方が有効の時、もう片方が無効の関係。
    CaptionChangeButton.Enabled = Not MultiSelectCheck.Value
End Sub

' リストボックスで選択されたチェックボックスを削除。
Private Sub SelectedCBsDeleteButton_Click()
    Dim i As Long
        For i = CBsListBox.ListCount - 1 To 0 Step -1
            If CBsListBox.Selected(i) = True Then
                CBs.Item(i + 1).Delete
            End If
        Next
        
        ' 削除後の状態を反映するために、リストボックスをリセットする。
        ResetCBsListBox
End Sub

Private Sub UserForm_Initialize()
    ' 初期値は、空白無視とする。
    ' ※使い勝手を考慮。
    IgnoreBlankCheck = True
    ' 既存のチェックボックス一覧をリストボックスに反映。
    CBsListBox.List = CheckBoxList
End Sub

Private Sub UserForm_Terminate()
    ' チェックボックスへの一時的着色を、
    ' ユーザーフォームを閉じる際に解消。
    ResetCBsListBox
End Sub

Private Sub CloseButton_Click()
    Unload Me
End Sub

Private Sub CBsListBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i As Long
        ' リストボックスの選択状況に合わせて、
        ' チェックボックスを着色する。
        For i = 0 To CBsListBox.ListCount - 1
            With CBs.Item(i + 1)
                If CBsListBox.Selected(i) Then
                    .Interior.Color = vbRed
                    ' 透明度70％
                    .ShapeRange.Fill.Transparency = 0.7
                Else
                    .Interior.Color = xlNone
                End If
            End With
        Next
        
        ' リストが単一選択モードの場合、変更キャプション名入力補助として
        ' テキストボックスをフォーカス。
        If CBsListBox.MultiSelect = fmMultiSelectSingle Then
            NewCaptionInputBox.SetFocus
        End If
End Sub

Private Sub SetCheckBoxButton_Click()
    Dim r As Range
        For Each r In Selection
            ' 空白を無視しないか、または空白でない場合のみチェックボックス配置。
            If IgnoreBlankCheck = False Or r.Value <> vbNullString Then
                ' CheckBox配置。
                SetCheckBox r, , r.Value
                ' 置き換えのため、セルの文字を削除。
                r.ClearContents
            End If
        Next
        ' チェックボックスの増減があるため、リストボックスをリセット。
        ResetCBsListBox
End Sub

Private Sub CaptionChangeButton_Click()
    
    Dim SelectedIndex As Long
        SelectedIndex = CBsListBox.ListIndex
        
        ' チェックボックス選択確認。
        If SelectedIndex = -1 Then
            MsgBox "対象となるCheckBoxが未選択です。"
            Exit Sub
        End If
    
        ' チェックボックスのキャプション変更。
        CBs.Item(SelectedIndex + 1).Caption = NewCaptionInputBox.Value
        ' 次の入力に備え、テキストボックスを初期化。
        NewCaptionInputBox.Value = vbNullString
        ' キャプション変更を反映するために、リストボックスをリセット。
        ResetCBsListBox
        ' どのチェックボックスが選ばれていたかを明示するため、改めて
        ' 対象をリストから選択。
        CBsListBox.Selected(SelectedIndex) = True
End Sub

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