VBAで丸をつけたいです。

質問

VBAかなりの初心者です。
先日、画像に添付したように、あらかじめテキストが入力されているセルを、ダブルクリックすると丸が付いたり消えたりするプログラムを教えてもらいました。
これはこれで使う機会があるので活用させてもらっているのですが。

できれば、ダブルクリックではなく、シングルクリックで丸が付いたり消えたりしたいのですが、できるでしょうか？
丸を付けたり消したりするセルには文字が入力されています。
丸をつけたり消したりしたいセルは時に結合されています。
丸をつけたり消したりしたいセルは連続していることもあれば、とびとびになっていることもあります。

前回教えて頂いたコードは以下のとおりです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Mark　の複数の範囲のセル/結合セルに　Wクリックで　赤○　つける/消す
Dim Ad As String
Dim Lp As Single, Tp As Single, Hp As Single
Dim Ov As Oval, Mark As Range

Set Mark = Range("A5：b7, d5：e7, g5：h7,A1:B3") '範囲の複数指定
If Intersect(Target, Mark) Is Nothing Then Exit Sub '範囲外は無視

With Target
Ad = .Address: Hp = .Height: Tp = .Top
If .Height > .Width Then Hp = .Width '縦長結合の場合に備える
Lp = .Left + ((.Width / 2) - (Hp / 2))

End With
Cancel = True
7
With ActiveSheet
.Unprotect '★
For Each Ov In .Ovals
If Not (Intersect(Target, Ov.TopLeftCell) Is Nothing) Then '既存○検出
Ov.Delete: Ad = "": ' Exit For '◎重複があるなら外し、削除優先する
End If
Next
If Ad <> "" Then
With .Ovals.Add(Lp, Tp, Hp, Hp)
.Interior.ColorIndex = xlColorIndexNone
.Border.Color = vbRed '　赤○にする
End With
End If
Protect , True, False, False '★
End With
End Sub

回答No.2

mu2011

NO1です。
>できれば左シングルクリックがいいのでして・・・
　⇒あいにく左シングルクリックだけのイベントは用意されいません。
　　近いイベントで「選択範囲が変わった時に発生」を利用しても良いのですが、
　　セル移動キー（方向キー、Tab、Enter）でも反応する、又削除する場合には
　　一旦範囲外に移動して戻るなど、操作上、紛らわしくなるのであえて
　　右クリックとした次第です。
　　多分、前回答の方もダブルクリックを選択されたのは、同じ様な理由と思います。

お礼

お返事おそくなってすみません。

そういうもんなんですね！

右クリックかダブルクリックでやってみます。

ありがとうございました。

回答No.1

mu2011

>ダブルクリックではなく、シングルクリックで丸が付いたり消えたりしたいのです
　⇒右シングルクリックでは駄目でしょうか。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　↓
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

又、次のコードをSet mark～の直前に移動して下さい。
　Cancel = True

お礼

お返事ありがとうございます。
自分としては、本当はダブルクリックも右シングルクリックもOKなのですが。
できれば左シングルクリックがいいのでして・・・
すみません。