オプションボタンの管理ツール：キャプションの変更

先日は、シート上に配置された複数のオプションボタンについて、リストボックスで選択したオプションボタンのグループ名を変更してみた。
infoment.hatenablog.com
今日は、各オプションボタンのキャプション変更に挑戦する。

今回のために、以下を追加した。

• 変更後キャプション入力用テキストボックス（CaptionTextBox）
• キャプション変更ボタン（CaptionEditButton）

また、グループ名変更ボタンは、上記に合わせて以下のように変更した。
変更前：GroupNameChangeButton
変更後：GroupNameEditButton

さて、今回必要な条件は以下のとおり。

◆ キャプション変更ボタンは、以下の場合に有効となる。

1. テキストボックスに何か入力されている。
2. 「●オプションボタン詳細」（DetailListBox）で選択されているオプション
   ボタンが一つだけである。

そこでまず、上記条件が満たされているか否かを得る関数を作成する。

Private Function DetailListSelectionFlag() As Boolean
    Dim Counter As Long
    Dim i As Long
        For i = 0 To DetailListBox.ListCount - 1
            If DetailListBox.Selected(i) = True Then
                Counter = Counter + 1
            End If
        Next
        
        ' 変更後のキャプションが入力済みであることも、Trueの条件に
        ' 追加しておく。
        If Counter = 1 And CaptionTextBox.Value <> vbNullString Then
            DetailListSelectionFlag = True
        End If
End Function

「●オプションボタン詳細」で選択した際のイベントに、キャプション変更ボタンの有効無効切り替えを追加する。

Private Sub DetailListBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    '「●グループ名」を初期化。
    ' ※今回追加。
    GroupListBox.Clear
    GroupListBox.List = Dict.Keys
    
    Dim i As Long
        For i = 1 To DetailListBox.ListCount
            With col.Item(i).Object
                Select Case DetailListBox.Selected(i - 1)
                    Case True
                        .ForeColor = vbYellow
                        .BackColor = 192
                    Case False
                        .ForeColor = myForeColor(i)
                        .BackColor = myBackColor(i)
                End Select
            End With
        Next
        
        ' 今回追加。
        CaptionEditButton.Enabled = DetailListSelectionFlag
End Sub

変更後キャプション入力用テキストボックスの変更イベントにも、ボタンの有効無効切り替えをセット。

Private Sub CaptionTextBox_Change()
    CaptionEditButton.Enabled = DetailListSelectionFlag
End Sub

最後に、変更ボタンを押した際の処理がこちら。

Private Sub CaptionEditButton_Click()
    col.Item(DetailListBox.ListIndex + 1).Object.Caption = CaptionTextBox.Value
    CaptionTextBox.Value = vbNullString
    Call ResetList
End Sub

↓ 今日までの、コードのまとめはこちらです。

◆ソースコード（クリックで展開）◆

Option Explicit
Dim col As Collection
Dim myForeColor() As Long
Dim myBackColor() As Long
Dim ListSeq() As Variant
Dim Dict As Dictionary

Private Sub CaptionEditButton_Click()
    col.Item(DetailListBox.ListIndex + 1).Object.Caption = CaptionTextBox.Value
    CaptionTextBox.Value = vbNullString
    Call ResetList
End Sub

Private Sub CaptionTextBox_Change()
    CaptionEditButton.Enabled = DetailListSelectionFlag
End Sub

Private Sub GroupListBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    '「●オプションボタン詳細」を初期化。
    ' ※今回追加。
    DetailListBox.Clear
    DetailListBox.List = ListSeq
    
    Dim i As Long
        With DetailListBox
            For i = 0 To .ListCount - 1
                If .List(i, 1) = GroupListBox.Value Then
                    .Selected(i) = True
                End If
            Next
        End With
        
        For i = 1 To col.Count
            With col.Item(i).Object
                If .GroupName = GroupListBox.Value Then
                    .ForeColor = vbYellow
                    .BackColor = 192
                Else
                    .ForeColor = myForeColor(i)
                    .BackColor = myBackColor(i)
                End If
            End With
        Next
End Sub

Private Sub DetailListBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    '「●グループ名」を初期化。
    ' ※今回追加。
    GroupListBox.Clear
    GroupListBox.List = Dict.Keys
    
    Dim i As Long
        For i = 1 To DetailListBox.ListCount
            With col.Item(i).Object
                Select Case DetailListBox.Selected(i - 1)
                    Case True
                        .ForeColor = vbYellow
                        .BackColor = 192
                    Case False
                        .ForeColor = myForeColor(i)
                        .BackColor = myBackColor(i)
                End Select
            End With
        Next

        CaptionEditButton.Enabled = DetailListSelectionFlag
End Sub

Private Sub GroupNameEditButton_Click()
    Dim i As Long
        For i = 1 To DetailListBox.ListCount
            With col.Item(i).Object
                Select Case DetailListBox.Selected(i - 1)
                    Case True
                        .GroupName = GroupNameTextBox.Value
                End Select
            End With
        Next
    Call ResetList
    GroupNameTextBox.Value = vbNullString
End Sub

Private Sub GroupNameTextBox_Change()
    If GroupNameTextBox.Value = vbNullString Then
        GroupNameChangeButton.Enabled = False
    Else
        GroupNameChangeButton.Enabled = True
    End If
End Sub

Private Sub UserForm_Initialize()

    Set col = New Collection
    Dim myObj As Excel.OLEObject
        For Each myObj In ActiveSheet.OLEObjects
            If myObj.progID = "Forms.OptionButton.1" Then
                col.Add myObj
            End If
        Next
        
    ReDim myForeColor(1 To col.Count)
    ReDim myBackColor(1 To col.Count)
    ReDim ListSeq(1 To col.Count, 1 To 3)
    
    Dim i As Long
    For i = 1 To col.Count
        With col.Item(i).Object
            ' 色の保存
            myForeColor(i) = .ForeColor
            myBackColor(i) = .BackColor
        End With
    Next

    Call ResetList
    GroupNameEditButton.Enabled = False
    CaptionEditButton.Enabled = False
End Sub

Private Sub UserForm_Terminate()
    Call ResetColor
End Sub

Private Sub ResetList()
    Set Dict = New Dictionary

    Dim i As Long
        For i = 1 To col.Count
            With col.Item(i).Object
                ListSeq(i, 1) = col.Item(i).Name
                ListSeq(i, 2) = .GroupName
                ListSeq(i, 3) = .Caption
                
                ' 重複除去のために辞書を用いているため、アイテム不問。
                Dict(.GroupName) = 1
            End With
        Next
        GroupListBox.List = Dict.Keys
        DetailListBox.List = ListSeq
End Sub

Private Sub ResetColor()
    Dim i As Long
        For i = 1 To col.Count
            With col.Item(i).Object
                .ForeColor = myForeColor(i)
                .BackColor = myBackColor(i)
            End With
        Next
End Sub

Private Function DetailListSelectionFlag() As Boolean
    Dim Counter As Long
    Dim i As Long
        For i = 0 To DetailListBox.ListCount - 1
            If DetailListBox.Selected(i) = True Then
                Counter = Counter + 1
            End If
        Next
        
        ' 変更後のキャプションが入力済みであることも、Trueの条件に
        ' 追加しておく。
        If Counter = 1 And CaptionTextBox.Value <> vbNullString Then
            DetailListSelectionFlag = True
        End If
End Function

参考まで。