選択したCheckBox(フォームコントロール)のキャプションを変更する

昨日は、リストボックスに表示したチェックボックス(フォームコントロール)の一覧において、リスト上で選択した名前に対応するチェックボックスの色を変えることに挑戦した。
infoment.hatenablog.com

今日は、選択したリストボックスのキャプションを変更することに挑戦する。
f:id:Infoment:20191110225856p:plain

やりたいことの受け皿として、ユーザーフォームに部品を追加。
【追加部品】

  • TextBox
    名称:NewCaptionInputBox
    新たなキャプション入力用
  • CommandButton
    名称:CaptionChangeButton
    キャプション変更用

リストボックスは複数選択可能(MultiSelect)になっているため、CaptionChangeButtonは、リストボックス内で一つだけ選ばれている時のみ、押下可とする。従って、ユーザーフォーム初期化時点では無効化しておく必要がある。

Private Sub UserForm_Initialize()
    ' 初期値は、空白無視とする。
    ' ※使い勝手を考慮。
    IgnoreBlankCheck = True
    ' 既存のチェックボックス一覧をリストボックスに反映。
    CBsListBox.List = CheckBoxList
    ' キャプション変更用ボタンの無効化。
    ' ※初期状態では、何も選ばれていないため。
    CaptionChangeButton.Enabled = False
End Sub

二つ同時に名称を変更するのは不味いので、リストボックス内で幾つ選ばれているか、知る必要がある。そこで今回はCounterという変数を設け、リストボックス内の選択数を数えることにした。2個以上であれば、問答無用で無効化する。

Private Sub CBsListBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i As Long
    ' 選択数確認用。
    Dim Counter 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
                    Counter = Counter + 1
                Else
                    .Interior.Color = xlNone
                End If
            End With
        Next
        
        ' 同キャプションのCheckBoxを存在させないために、
        ' キャプション変更ボタンの有効無効を選択数によって切り替え。
        Select Case Counter
            Case 1
                CaptionChangeButton.Enabled = True
            Case Else
                CaptionChangeButton.Enabled = False
        End Select
End Sub

最後に、コマンドボタンを押下したときの、キャプション変更を作成。変更後は、リストボックスの更新も忘れずに実施する。

Private Sub CaptionChangeButton_Click()
    ' ListBoxがMultiSelectの場合、ListIndexで選択中の
    ' 番号が上手く取れない?回避策として、Selectedで確認。
    Dim i As Long
        For i = 0 To CBsListBox.ListCount - 1
            If CBsListBox.Selected(i) = True Then
                CBs.Item(i + 1).Caption = NewCaptionInputBox.Value
                ' 次の変更に備え、テキストボックスを空欄にする。
                NewCaptionInputBox.Value = vbNullString
                Exit For
            End If
        Next
        
        ' キャプション変更後の状態に、リストボックスを更新する。
        With CBsListBox
            .Clear
            .List = CheckBoxList
            ' 変更対象を見える化するため、改めてi番目を選択。
            .Selected(i) = True
        End With
End Sub

それでは、試してみよう。
f:id:Infoment:20191110231247g:plain

まずまず、といったところ。
引き続き、選択したチェックボックスのグループ化に挑戦する。

明日に続きます。

参考まで。