[[20150529095133]]　『VBAでWクリックで図形の挿入、変更、削除の３段階』（topp99）　ページの最後に飛ぶ

『VBAでWクリックで図形の挿入、変更、削除の３段階処理』（topp99）

セルをダブルクリックで黒丸を挿入、もう一度ダブルクリックで削除というネットで拾ったコードを使用しています。
そこにセルをダブルクリックで黒丸を挿入、もう一度ダブルクリックで赤丸に変更、もう一度ダブルクリックで削除と
したいのですが方法がわかりません。コードを教えていただけると助かります。よろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

すみません。現状のコードを入れ忘れました。
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("f29：n31, v28:ak31, an28:ao28, g39:m41, f10:f19, h10:h19") '範囲の複数指定
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 = vbBlack '　黒○にする
End With
 End If
 Protect , Contents:=True 'True, False, False '★

 End With
 End Sub

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Ad As String
    Dim Lp As Single
    Dim Tp As Single
    Dim Hp As Single
    Dim Ov As Oval

    If Intersect(Target, Range("f29：n31, v28:ak31, an28:ao28, g39:m41, f10:f19, h10:h19")) Is Nothing Then Exit Sub
    Cancel = True

    With ActiveSheet
        .Unprotect '★
        For Each Ov In .Ovals
            With Ov
                If Not (Intersect(Target, .TopLeftCell) Is Nothing) Then '既存○検出
                    If .Border.Color = vbBlack Then
                        .Border.Color = vbRed
                    Else
                        Ov.Delete
                    End If
                    Ad = Target.Address
                    Exit For
                End If
            End With
        Next
        If Ad = "" Then
            With Target
                Hp = IIf(.Height < .Width, .Height, .Width)
                Tp = .Top
                Lp = .Left + (.Width - Hp) / 2
            End With
            With .Ovals.Add(Lp, Tp, Hp, Hp)
                .Interior.ColorIndex = xlColorIndexNone
                .Border.Color = vbBlack
            End With
        End If
        .Protect , Contents:=True 'True, False, False '★
    End With
 End Sub
（???） 2015/05/29(金) 11:08

???さん
思っていた通りにできました。
ありがとうございます。

コメント返信：

[ 一覧(最新更新順) ]

[[20150529095133]] 『VBAでWクリックで図形の挿入、変更、削除の３段階』（topp99） ページの最後に飛ぶ

[[20150529095133]]　『VBAでWクリックで図形の挿入、変更、削除の３段階』（topp99）　ページの最後に飛ぶ