質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.63%

VBAのボタンの色に関して

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 781

kumikumi550

score 10

前提・実現したいこと

VBAで
50個あるボタンに対して
それぞれ5個ずつのグループを作り
各グループに対して1つのボタンしか押せない(色がつかない)
→グループ内では1度ボタンを押した後に別のボタンを押すと、ほかのボタンは元の色に戻る
ようにしたい
そのために、とりあえずは押したボタンを自動認識し、色が変わるようにしたい

発生している問題・エラーメッセージ

エラーはないが機能しない

~class1~
Public WithEvents myBtn As MSForms.CommandButton
Private Sub myBtn_Click()
    Dim i As Integer
    i = myBtn.Index
    n = "CommandButton" & i & ".BackColor"
    If i <= 5 Then
        n = RGB(255, 0, 0)
    ElseIf i <= 10 Then
        n = RGB(255, 0, 0)
    End If
End Sub
~module~
Public myClass As New Class1
Sub Auto_Open()
  Dim ctrl As Object
  Dim i As Integer
Static myClass() As Class1
  For Each ctrl In Worksheets("Sheet1").OLEObjects
    If TypeOf ctrl.Object Is MSForms.CommandButton Then
      ReDim Preserve myClass(i)
      Set myClass(i) = New Class1
      Set myClass(i).myBtn = ctrl.Object
      i = i + 1
    End If
  Next
End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • kumikumi550

    2018/12/07 13:06

    Userform.controlの存在を知りましたが、Userformは使えないので、通常のSheetでも使えるほうほうをしりたいです。

    キャンセル

回答 2

+1

解決済みになっちゃいましたが、興味深い内容なので作ってみました。

今回の要件は、
複数のボタンをグループ化して、その中の一つだけを選択できるようにするということですね。

せっかくクラスにするのですから、できるだけ汎用性のあるものにしたいので、
下記のような設計を考えてみました。

SelectButtonクラス
クリックすると選択状態(背景色 赤)になる
・Selectedプロパティ 選択=True / 非選択=False

SelectButtonGroupクラス
SelectButtonのグループ
・Addメソッド コマンドボタンをグループに追加する。

このクラスを作ることによって各グループごとにボタンの数が異なる場合でも簡単に対応できます。

SelectButtonクラス

Option Explicit
Private WithEvents btn As MSForms.CommandButton
Private Slected_ As Boolean    '選択
Private GroupBtns_ As Collection

'クラスにコマンドボタンと属するグループ(Collection)を登録する。
Public Sub setBtn(ByVal cb As MSForms.CommandButton, ByVal GroupBtns As Collection)
    Set btn = cb
    Set GroupBtns_ = GroupBtns
End Sub

'選択状態の設定
Public Property Let Slected(ByVal new_Slected As Boolean)
    If Slected_ <> new_Slected Then
        Slected_ = new_Slected
        If Slected_ Then
            btn.BackColor = vbRed
        Else
            btn.BackColor = vbButtonFace
        End If
    End If
End Property

'選択状態の取得
Public Property Get Slected() As Boolean
    Slected = Slected_
End Property

Private Sub Btn_Click()
    Dim ctl As SelectButton

    For Each ctl In GroupBtns_
        ctl.Slected = False
    Next
    Slected_ = True
    btn.BackColor = vbRed
End Sub

SelectButtonGroupクラス

Option Explicit

Private BtnGrp As Collection

Public Sub Add(ByVal btn As MSForms.CommandButton)
    Dim selBtn As SelectButton
    Set selBtn = New SelectButton

    selBtn.setBtn btn, BtnGrp
    BtnGrp.Add selBtn
End Sub

Private Sub Class_Initialize()
    Set BtnGrp = New Collection
End Sub

Private Sub Class_Terminate()
    Dim selBtn As SelectButton

    For Each selBtn In BtnGrp
        selBtn.Slected = False
        Set selBtn = Nothing
    Next
    Set BtnGrp = Nothing
End Sub

Sheet1 に、CommandButton1 ~ 10 の10個のコマンドボタンがあり、
1 ~ 5, 6 ~ 8, 9 ~ 10 の3グループに分ける、
Sheet2 に、CommandButton1 ~ 5 がありすべて一つのグループにする、
場合のコード例

ThisWorkBookモジュール

Option Explicit
Private SelBtnGrp(3) As SelectButtonGroup

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set SelBtnGrp(0) = Nothing
    Set SelBtnGrp(1) = Nothing
    Set SelBtnGrp(2) = Nothing
    Set SelBtnGrp(3) = Nothing
End Sub

Private Sub Workbook_Open()
    Dim i As Integer

    With Worksheets("Sheet1")
        Set SelBtnGrp(0) = New SelectButtonGroup
        For i = 1 To 5
            SelBtnGrp(0).Add .OLEObjects("CommandButton" & i).Object
        Next
        Set SelBtnGrp(1) = New SelectButtonGroup
        For i = 6 To 8
            SelBtnGrp(1).Add .OLEObjects("CommandButton" & i).Object
        Next
        Set SelBtnGrp(2) = New SelectButtonGroup
        For i = 9 To 10
            SelBtnGrp(2).Add .OLEObjects("CommandButton" & i).Object
        Next
    End With
    With Worksheets("Sheet2")
        Set SelBtnGrp(3) = New SelectButtonGroup
        For i = 1 To 5
            SelBtnGrp(3).Add .OLEObjects("CommandButton" & i).Object
        Next
    End With
End Sub

一応、最小限の雛形です。今後、拡張したいこととして、下記が考えられます。

SelectButtonクラスに
Countプロパティ、
SelectIndexプロパティ、
Changeイベント
などの実装

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/12/08 09:50

    ThisWorkBookモジュールのコード例を、複数のシートにコマンドボタンを配置した場合のコード例に修正しました。

    キャンセル

  • 2018/12/08 10:28

    SelectButyonGroup内の
    selBtn.setBtn btn, BtnGrp
    の.setBtnにメソッドまたはデータメンバーが見つかりません
    エラーが出ます

    キャンセル

  • 2018/12/08 10:34 編集

    ボタン番号の問題でした
    SelBtnGrp(1).Add .OLEObjects("CommandButton" & i).Object
    にオブジェクト変数またはwithブロック変数が設定されていません
    エラーが出ます

    キャンセル

checkベストアンサー

0

修正してみました。
似ているようで若干違います。
クラスの使い方ですかね。
見比べてみてください。

Class1

Private WithEvents Btn As MSForms.CommandButton

Public Sub myBtn(ByVal cb As MSForms.CommandButton)
    Set Btn = cb
End Sub

Private Sub Btn_Click()
    Dim i As Integer
    i = Btn.Index
    If i <= 1 Then
        Btn.BackColor = RGB(255, 0, 0)
    ElseIf i <= 2 Then
        Btn.BackColor = RGB(0, 255, 0)
    ElseIf i <= 3 Then
        Btn.BackColor = RGB(0, 0, 255)
    End If
End Sub


Module1

Public myClass() As Class1

Sub Auto_Open()

  Dim ctrl As Object
  Dim i As Integer

  i = 0
  For Each ctrl In Worksheets("Sheet1").OLEObjects
    If TypeOf ctrl.Object Is MSForms.CommandButton Then
      ReDim Preserve myClass(i)
      Set myClass(i) = New Class1
      myClass(i).myBtn ctrl.Object
      i = i + 1
    End If
  Next

End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/12/07 14:11

    例えば、
    2を押す→2が赤くなり1,3,4,5が黒くなる
    3を押す→3が赤くなり1,2,4,5が黒くなる

    としたい場合はどうすれば良いでしょうか

    キャンセル

  • 2018/12/07 14:45

    簡単なのはクリックイベントで一旦全部黒にして、押されたボタンだけを赤にする方法でしょうか。
    Private Sub Btn_Click()
    Dim ctrl As Object
    For Each ctrl In Worksheets("Sheet1").OLEObjects
    If TypeOf ctrl.Object Is MSForms.CommandButton Then
    ctrl.Object.BackColor = vbBlack
    End If
    Next
    Btn.BackColor = vbRed
    End Sub

    しかし理由はわからないのですが、どうも動きが鈍いというか、元赤のボタンの描画が3回発生しているような。。。
    黒にしたあと赤になって黒になる。
    時間があれば調べてみますが、ひとまずはこんな感じで。

    キャンセル

  • 2018/12/07 17:34 編集

    横から失礼しますm(_ _)m

    Btn_Click時に押したボタンに対して色付けをするだけではなく、同じグループのボタンの色付けも必要ですよね。

    ttyp03さんのコードを元にして、Class1のBtnをPublicで宣言し、myClassに格納したボタンコントロールを参照できるようにしてみてはどうでしょうか?

    そのうえで、Btn_Click時にはグループ単位でmyClassをループ処理してそれぞれに色設定を行う、といった具合です。

    ```
    Public WithEvents Btn As MSForms.CommandButton '外部から参照できるようにPublicで宣言

    Public Sub myBtn(ByVal cb As MSForms.CommandButton)
    Set Btn = cb
    End Sub

    Private Sub Btn_Click()

    Dim i As Integer
    Dim i2 As Integer
    Dim iGrpSt As Integer '押したボタンのグループの先頭

    Const GRP_CNT = 5 '1グループのボタン数

    i = Btn.Index - 1

    iGrpSt = Int((i) / GRP_CNT) * GRP_CNT

    'グループ内のボタンだけループ処理
    For i2 = iGrpSt To iGrpSt + GRP_CNT - 1

    If i2 = i Then
    myClass(i2).Btn.BackColor = RGB(0, 0, 200)
    Else
    myClass(i2).Btn.BackColor = RGB(200, 200, 200)
    End If

    Next

    End Sub
    ```

    参考になれば幸いです。

    キャンセル

  • 2018/12/07 21:49

    できました
    ありがとうございます
    純粋な、質問なのですが
    各グループごとにボタンの数が異なる場合のアイデアなどありますか?

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.63%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる