スキルアップ・問題解決なら、モーグにおまかせ！

お世話になります。
 
Excelのシート上で"F9:L12"にカレンダー状に数字が入力されています。
その範囲内の任意のセルをダブルクリックするとオートシェイプで黒丸が表示されるVBAを作成しました。
ところがダブルクリックして黒丸を表示させた後に再度ダブルクリックすると以下のソースの赤文字のところが実行されずにワークシートの左上あたりにオートシェイプが表示されてしまいます。
この原因が解決できずに困っています。アドバイスを頂けないでしょうか。
 
また、黒丸が表示されているセルはダブルクリックしても黒丸は追加されないようにしたいのですが、これもアドバイスいただけないでしょうか。ブーリアン型の変数を使用したら出来ないかなと考えています。
 
ソースは標準モジュールではなく、Sheet１に記述しています。
 
以上よろしくお願いいたします。
 
 
Option Explicit
 
Public t As Range
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     
    Dim s As String
    Dim r As Range
     
        s = ActiveCell.Address
 
        For Each r In Range("F9:L12")
         
            If r.Address = s Then
                 
                ActiveSheet.Shapes.AddShape(msoShapeOval, 10, 10, 20, 20).Name = s
                      
                    With ActiveSheet.Shapes(s)
                     .Top = r.Top
                     .Left = r.Left + 18
                     .Fill.Visible = msoFalse
                     .Line.ForeColor.RGB = vbBlack
                     .Line.Weight = 3
                    End With
                 
' Debug.Print r.Address & ":" & s
                  
                 Exit For
                  
            End If
         
        Next r
     
    Cancel = True
     
     
End Sub
 
 
Sub sakujyo()
     
   'シート内の図形を全選択
    ActiveSheet.Shapes.SelectAll
    '選択した図形を削除
    Selection.ShapeRange.delete
End Sub

> 以下のソースの赤文字のところが実行されずに
それはどうやって確認されましたか？
 
step実行してみてください。
実行はされていますが、同名のShapeが既にあり、
その古い方のShapeに対して処理が行われているはずです。
 
そして肝心の二回目に作成したShapeには処理がされないので、
>ワークシートの左上あたりにオートシェイプが表示されてしまいます。
ということになっているのです。
 
色々な対応方法があるかと思いますが、
例えば以下のようにすることが考えられます。参考にしてみてください。

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim s As String
    Dim shp As Variant

    '"F9:L12"以外のセルなら直ぐに終了。
    If Intersect(Target, Range("F9:L12")) Is Nothing Then Exit Sub
    
    Cancel = True
    s = Target.Address

    '同名のShapeが既にあれば、終了。
    On Error Resume Next
    Set shp = ActiveSheet.Shapes(s)
    If Not IsEmpty(shp) Then
        On Error GoTo 0
        Exit Sub
    End If
    On Error GoTo 0
    
    'Shapeを作成し、Addressを名称にセット
    ActiveSheet.Shapes.AddShape(msoShapeOval, 10, 10, 20, 20).Name = s
    With ActiveSheet.Shapes(s)
        .Top = Target.Top
        .Left = Target.Left + 18
        .Fill.Visible = msoFalse
        .Line.ForeColor.RGB = vbBlack
        .Line.Weight = 3
    End With
End Sub

代案コード
  
殆ど,simpleさんとおなじですが、作ってしまったので、アップしておきます。

 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     
    Dim s As String
    Dim r As Range
    Dim shape As shape
     
        
    If Not Intersect(Target, Me.Range("F9:L12")) Is Nothing Then
        
        s = Target.Address
        For Each shape In Me.Shapes
            If shape.Name = s Then
                Exit For
            End If
        Next
        If shape Is Nothing Then
            Set shape = Me.Shapes.AddShape(msoShapeOval, Target.Left + 18, Target.Top, 20, 20)
            With shape
                .Name = s
                .Fill.Visible = msoFalse
                .Line.ForeColor.RGB = vbBlack
                .Line.Weight = 3
            End With
        End If
    End If
    
    Cancel = True
End Sub

アドバイス
 
シートに作成した図形に名前を付ける際、
名前が重複してもエラーにはなりません。
その名前を指定して、アクセスすると、最初に作成した図形が対象になります。
従って、意図した図形を取得することができなくなります。
 
インデックスで図形を取得する際も、名前で判定できないので、
別の方法を考える必要があります。

simpleさん
WinArrowさん
 
無事に問題を解決できました！
 
抜粋ですが
'"F9:L12"以外のセルなら直ぐに終了。
    If Intersect(Target, Range("F9:L12")) Is Nothing Then Exit Sub
や
  For Each shape In Me.Shapes
            If shape.Name = s Then
                Exit For
            End If
        Next
 
のところが特に勉強になりました。
 
ありがとうございました！