[[20190224121714]]　『セルをクリックしたら色が変わるマクロ』（たく）　ページの最後に飛ぶ

『セルをクリックしたら色が変わるマクロ』（たく）

D列のセルを対象でクリックしたらそのセルの色が変わるようなマクロを考えているのですが、一度クリックしてもう一度同じセルをクリックしたら消えるようには出来ないでしょうか？
ダブルクリックでのコードでは出来ることは確認出来ましたが、worksheet selectionchangeのコードでは一度別のセルをクリックしてからしか消せないのでクリックする度に付いたり消えたりさせることはないのでしょうか？
タッチパネルでの使用を考えているので、 selectionchangeの動作で考えてます。
アドバイス等ありましたらよろしくお願いします。

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

 こんにちは　＾＾ 
Option Explicit

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Interior.ColorIndex > 0 Then
        Target.Interior.ColorIndex = 0
    Else
        Target.Interior.ColorIndex = 3
    End If
    Cancel = True
End Sub

 とかでも　エラー処理は考えていません。。。　m(_ _)m
（隠居じーさん） 2019/02/24(日) 12:48

Bad news ですが。
　
＞一度クリックしてもう一度同じセルをクリックしたら消えるようには出来ないでしょうか？
SelectionChangeの仕様上できません。
選択状態が変わる（つまり、SelectionのAddressが変更になること）を
イベント発生の要件にしていますから、無理ですね。
　
別のイベントプロシージャで折り合いを付けることをお薦めします。

（γ） 2019/02/24(日) 13:38

一度別のセルをクリックしてからしか消せないので

なら別のセルをクリックすれば
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With Target
        If .Column <> 4 Then Exit Sub
        If .Interior.ColorIndex = -4142 Then
            .Interior.ColorIndex = 3
        Else
            .Interior.ColorIndex = -4142
        End If
        Application.EnableEvents = False
        .Offset(1).Activate
        Application.EnableEvents = True
    End With
End Sub
（ピンク） 2019/02/24(日) 14:22

適当な思い付きですけど、セルの大きさぴったりに、フォームコントローラのボタンかActiveXコントローラのコマンドボタンを置いて、クリックするたびに色を変えるってのはだめでしょうか？

（もこな２） 2019/02/24(日) 14:53

 >D列のセルを対象でクリックしたらそのセルの色が変わるようなマクロを考えているのですが

 上にも行きたいので横にしましたぁ(^^;

 Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
    If .Column <> 4 Then Exit Sub
    If .Interior.ColorIndex = -4142 Then
        .Interior.ColorIndex = 3
    Else
        .Interior.ColorIndex = -4142
    End If
    Application.EnableEvents = False
        .Offset(, 1).Activate
    Application.EnableEvents = True
End With
End Sub
（SoulMan） 2019/02/24(日) 14:55

いろいろアドバイスありがとうございます。
やはりSelectionChangeでは一度別のセルを選択してからしか無理そうですね。
タッチパネルでの使用目的のためダブルクリックでのコードでは動作しないため
SelectionChangeでの方法はないかと考えてました。
チェックボックスを設置して条件式書式でとも考えましたが、テーブル内で行を挿入したり削除したりと
頻繁に行うため難しいかなと思ってます。
使用目的は生産計画の中で終わったものを一時的に色をつけて消し込みをしたいと思ってます。
現場での使用でマウスも使わないため、出来る限り不要動作は避けたいと思った次第です。
（たく） 2019/02/24(日) 18:57

時間過ぎてしまったけど、見てくれないかなぁ？

もこな２さん案で、ちょっと作ってみました。使ったのはテキストボックスで、これをセルに合わせて重ねてしまいます。四角形とかだと、セルに書かれた文字を隠してしまうので、テキストボックスなのです。これなら、同じセルをタッチしたつもりでも、実は2度目はテキストボックスをクリックした事になり、イベントが取れます。

 【標準モジュール】
 Public Const iColor = &H4040FF

 Sub test()
    With ActiveSheet.Shapes(Application.Caller)
        .TopLeftCell.Select
        If .TopLeftCell.Interior.ColorIndex = -4142 Then
            .TextFrame2.TextRange.Text = .TopLeftCell.Text
            .Fill.Transparency = 0
            .TopLeftCell.Interior.Color = iColor
        Else
            .TextFrame2.TextRange.Text = ""
            .Fill.Transparency = 1
            .TopLeftCell.Interior.ColorIndex = -4142
        End If
    End With
 End Sub

 【シートモジュール】
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim iEr As Long

    If Target.Column <> 4 Then Exit Sub
    If Target.Count <> 1 Then Exit Sub

    On Error Resume Next
    Shapes("四角").Visible = True
    iEr = Err.Number
    On Error GoTo 0

    If iEr <> 0 Then
        With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Target.Left, Target.Top, Target.Width, Target.Height)
            .Name = "四角"
            .OnAction = "test"
            .Line.Visible = msoFalse
            .Fill.ForeColor.RGB = iColor
            .Fill.Transparency = 0
            .Fill.Solid
            With .TextFrame2
                .MarginLeft = 2
                .MarginRight = 0
                .MarginTop = 4
                .MarginBottom = 2
                .WordWrap = msoFalse
                .VerticalAnchor = msoAnchorMiddle
            End With
        End With
    End If

    With ActiveSheet.Shapes("四角")
            With .TextFrame2
                .TextRange.Font.Name = Target.Font.Name
                .TextRange.Font.Size = Target.Font.Size
                .TextRange.Text = Target.Text
                Select Case Target.HorizontalAlignment
                Case xlCenter
                    .HorizontalAnchor = msoAnchorCenter
                Case Else
                    .HorizontalAnchor = msoAnchorNone
                End Select
            End With
        .Left = Target.Left
        .Top = Target.Top
        .Width = Target.Width
        .Height = Target.Height
        If Target.Interior.ColorIndex = -4142 Then
            .TextFrame2.TextRange.Text = Target.Text
            .Fill.Transparency = 0
            Target.Interior.Color = iColor
        Else
            .TextFrame2.TextRange.Text = ""
            .Fill.Transparency = 1
            Target.Interior.ColorIndex = -4142
        End If
    End With
 End Sub

もし、マクロ実行後にセルの大きさやフォントを変えた場合、手作業でテキストボックスを削除する必要があります。（クリック後に右クリックすると、テキストボックスが見えます）
（???） 2019/02/26(火) 16:01

コメント返信：

[ 一覧(最新更新順) ]

[[20190224121714]] 『セルをクリックしたら色が変わるマクロ』（たく） ページの最後に飛ぶ

[[20190224121714]]　『セルをクリックしたら色が変わるマクロ』（たく）　ページの最後に飛ぶ