[[20221231003628]]　『クリックしたらセルに色をつけたい』（まぁーちゃん）　ページの最後に飛ぶ

『クリックしたらセルに色をつけたい』（まぁーちゃん）

A４からJ２５の範囲で各セルにクリックしたら色がつくようにしたいです。
D２からJ２の範囲で各色が配色してます。
そのD２からJ２範囲でクリックしたら色を取得しB２に取得した色を表示し
A４からJ２５の範囲で各セルにクリックしたら色がつくようにしたいのですが、どちら様かご教授願います。よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

クリックとは、ワンクリックですか？
ご教授と言う前に少しは自分で調べましょう。

（甘ったれ） 2022/12/31(土) 01:14:51

 配色からの選択は、右クリックで B2 へ選んだら
 A4 から J25 の範囲で各セルにクリックしたら色がつく

 こんなところでしょうか？

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim Color_Selection As Range
    Set Color_Selection = Range(Cells(2, "D"), Cells(2, "J"))
    If Application.Intersect(Target, Color_Selection) Is Nothing Then Exit Sub
    If Target.CountLarge <> 1 Then Exit Sub
        Cells(2, "B").Interior.Color = Target.DisplayFormat.Interior.Color
    Cancel = True
 End Sub

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range, Change_Range As Range
    Set Change_Range = Range(Cells(4, "A"), Cells(25, "J"))
    If Application.Intersect(Target, Change_Range) Is Nothing Then Exit Sub
    If Target.CountLarge <> 1 Then Exit Sub
    For Each rng In Selection
        Set Target = Intersect(Target, Selection)
        Application.EnableEvents = False
        Target.Interior.Color = Cells(2, "B").Interior.Color
        Application.EnableEvents = True
    Next
 End Sub

（あみな） 2022/12/31(土) 04:51:12

早速の返信ありがとうございます。
いろいろとネット調べたんですが、よくわからなくて質問しました。
プラス質問ですが、ワンクリックで指定のセルに色づけはできましたが、色の取り消ししたいです。
B2の色と指定しているセル範囲で同じ色のところをワンクリックしたら色が消えることってできますか？
すいませんがよろしくお願いします。
（まぁーちゃん） 2023/01/01(日) 23:51:45

 IF 文で分岐する、もしくはカラーパレットを、1セル塗りつぶしなしにすれば
 クリックしたセルが全て色が無くなります。

 Application.EnableEvents = False
 If セル範囲で同じ色のところ = B2の色 Then
   ワンクリックしたら色が消えるセル = 塗りつぶしなし設定色
 Else
   ワンクリックしたら色が着く = B2の色
 End If
 Application.EnableEvents = True

（あみな） 2023/01/02(月) 06:06:55

ありがとうございました。
上手く出来ました。
また、わからないことがありましたら質問したいと思います。
ありがとうございました
（まぁーちゃん） 2023/01/03(火) 00:47:26

指定範囲でシングルクリックで色付けできますが、右くりっく、左クリックの、どちらでも色がつくんですね！。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
このPrivate Sub は、右クリック、左クリック関係なくシングルクリックほ命令文なんですね。

一応確認ですが、右クリックしか色付けできないようにすることって出来ますか？

（まぁーちゃん） 2023/01/03(火) 01:03:19

 ＞一応確認ですが、右クリックしか色付けできないようにすることって出来ますか？

 はい、勿論可能です。

 別のシートに、下記のマクロを入れて試してください。

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)						
    Dim rng As Range						
    Dim Cange						
    For Each rng In Selection						
            Set Cange = Intersect(Target, Selection)						
            Debug.Print "Cange：＝" & Cange.Address						
            Cange.Interior.ColorIndex = 6						
    Next						
    Cancel = True						
 End Sub

 できましたか？ … できましたね。

 でも、配色のイベントで既に「右クリック」のイベントを使用しているので						
 同じシートに、同じイベントを入れる事ができないのです。

 では、どうしたら良いかと言う…お話になりますが						
 配色の設定を、Worksheet_BeforeDoubleClick　「ダブルクリック」にして						
 マクロを書き直せば良いのです。

 どうしても、右クリックが使用したいなら						
 ご自身でマクロを書き直してください。( 頑張りましょう )

 でもその前に確認ですが、右クリックを使用したいと言うよりも						
 対象範囲のセルの値を変更する時に、背景色が変更してしますのを						
 避けたいのですよね？違うかな？

 なら、こちらは別案です。

 配色パレットの上のセル等が、使用しないで空いていると思います。						
 例、J1 とかに入力規則を使用して、ON,OFF で切替できるようにします。

 ON  : クリックで背景色が着くように						
 OFF : 何も背景色が着かないように

 でクリックイベントに、一文追加して、切替えて使用する方法です。

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)						
    Dim rng As Range, Change_Range As Range						
    Set Change_Range = Range(Cells(4, "A"), Cells(25, "J"))						
    If Application.Intersect(Target, Change_Range) Is Nothing Then Exit Sub						
    If Target.CountLarge <> 1 Then Exit Sub						
    ●● △△△("J1") = "●●" Then △△ ●●　← ここに条件を追加します。						
    For Each rng In Selection						
        Set Target = Intersect(Target, Selection)						
        Application.EnableEvents = False						
        If Target.Interior.Color = Cells(2, "B").Interior.Color Then						
            Target.Interior.Color = xlNone						
        Else						
            Target.Interior.Color = Cells(2, "B").Interior.Color						
        End If						
        Application.EnableEvents = True						
    Next						
 End Sub

 ※●△に、適切に入れたら完成します。

（あみな） 2023/01/03(火) 20:50:08

横からですが何点か。

■１
↓を拝見するとちょっと勘違いされているのではないでしょうか？
＞Private Sub Worksheet_SelectionChange(ByVal Target As Range)
＞このPrivate Sub は、右クリック、左クリック関係なくシングルクリックほ命令文なんですね。

「SelectionChangeイベント」は読んでそのまま、選択範囲が変わったときに発動します。
なので、マウス操作じゃなくただのカーソル移動でも発動しますし、選択範囲が変わらなければクリックしても発動しません。
よって「クリックしたら」ということ以外も検討されるとよいとおもいます。

 ※↓のトピックで似たような話をしました。参考になると思いますので読んでみてはどうでしょうか？
[[20220801135046]]　『vba』（bukky）

■２
＞いろいろとネット調べたんですが、よくわからなくて質問しました。
どのようなことを「いろいろとネット調べた」のでしょうか？
完成してなくても、現状のコードを示して相談されると勘違いされているであろう部分などを含め、具体的なアドバイスが得られやすいと思います。

■３
既にあみなさんと話が進んでいるのでそちらが終わってからお読みいただければとおもいますが、

 (1)色の選択は「SelectionChangeイベント」を使う
 (2)色を付けるのは「BeforeRightClickイベント」を使う

と考えると↓のようでもよいと思います。

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Not Intersect(Range("D2:J2"), ActiveCell) Is Nothing Then
            Range("D2:J2").Borders.LineStyle = xlNone
            ActiveCell.Borders.Weight = xlThick
        End If
    End Sub
    '--------------------------------------------------------------------------------
    Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
         Dim MyRNG As Range, tmpRNG As Range
         If Not Intersect(Range("A4:J25"), Target) Is Nothing Then
             If Intersect(Range("A4:J25"), Target).Address = Target.Address Then
                Cancel = True
                For Each MyRNG In Range("D2:J2")
                    If MyRNG.Borders.LineStyle = xlContinuous Then
                        Intersect(Range("A4:J25"), Target).Interior.Color = MyRNG.Interior.Color
                        Exit For
                    End If
                Next MyRNG
            End If
        End If
    End Sub

（もこな２） 2023/01/04(水) 14:02:21

あみなさんありがとうございます。
j1に入力規則でリスト選んで"on","off"で表示できるようにし

 ●● △△△("J1") = "●●" Then △△ ●●　← ここに条件を追加します。
→If Range("J1") = "off" Then Exit Sub
これを追加しました。一応確認ですがこれで合ってますか？
動作は、ちゃんと動いてます。

（まぁーちゃん） 2023/01/04(水) 22:11:36

 入力規則のアルファベット（小文字）で設定したんですね。				
 大丈夫 (*ゝ艸・)b .+ﾟ*｡:ﾟで～す。

 間違ってたら動いてくれませんから				
 動かせた人が…勝者になります。(笑)

（あみな） 2023/01/04(水) 22:34:35

いろいろ勉強になりました。
あみなさん、モコナ２さんありがとうございました。
まだまだ未熟なので本など買って勉強したいと思います。
わからなくなったら、質問したいと思います。
ありがとうございました。
（まぁーちゃん） 2023/01/04(水) 23:12:44

コメント返信：

[ 一覧(最新更新順) ]

[[20221231003628]] 『クリックしたらセルに色をつけたい』（まぁーちゃん） ページの最後に飛ぶ

[[20221231003628]]　『クリックしたらセルに色をつけたい』（まぁーちゃん）　ページの最後に飛ぶ