オプションボタンの管理ツール：指定ボタンの色変更 ②

Excel VBA 作ってみた

昨日は、シート上に配置された複数のオプションボタンについて、どのオプションボタンが選択されたか見える化してみた。
infoment.hatenablog.com

今日は、選択したオプションボタンについて、グループ名を変更することに挑戦する。
f:id:Infoment:20190418234916p:plain

まず、レイアウトは、こんな感じだ。
f:id:Infoment:20190418235005p:plain

グループ名を入力するテキストボックスは、中身が空の場合、変更ボタンを押せないようにする。またこれに伴い、リストの更新や色の変更が頻繁に行われるため、Intializeから外に出すことにした。

↓ 色のリセット。

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 Sub ResetList()
        
    Dim Dict As Dictionary
    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

お陰で、InitializeとTerminateが少しすっきりした。

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
    GroupNameChangeButton.Enabled = False

End Sub

Private Sub UserForm_Terminate()
    Call ResetColor
End Sub

テキストボックスの入力状況とボタンの有効 ⇔ 無効は、こちらで切り替える。

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

最後に、変更ボタンをクリックしたときの動作を作成する。

Private Sub GroupNameChangeButton_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

↓ 結果がこちら。
f:id:Infoment:20190418235755g:plain

途中経過としては、こんなものかな。

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

参考まで。