[[20151119155804]]　『セルをダブルクリックしてセル内の文字をオートシ』（nitro）　ページの最後に飛ぶ

『セルをダブルクリックしてセル内の文字をオートシェイプの丸印で囲う方法』（nitro）

Ａ１：Ｂ２のセル内にりんご（Ａ１）・みかん（Ａ２）・ぶどう（Ｂ１）・バナナ（Ｂ２)の文字が入っているとして、りんごをダブルクリックするとりんごの文字を丸印で囲い、もう一度丸印をダブルクリックすれば消去できるようにするようなＶＢＡを教えて欲しいです。

ただしシート全体にその効果を反映させるのではなく（他の箇所でダブルクリック出来なくなるため）、Ａ１：Ｂ２の範囲内でのみ効果が出るようにしたいです。

是非ご教示下さいます様お願い致します。

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

 いろんな方法がありますが、コード的に、簡単になる提案として。

 ・シートモジュールに以下を貼り付け

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("A1:B2")) Is Nothing Then Exit Sub
    Cancel = True
    With Shapes("Oval" & Target.Address(False, False))
        .Visible = True
    End With
 End Sub

 Sub Dlt()
    Shapes(Application.Caller).Visible = False
 End Sub

 ・A1,A2,B1,B2 それぞれに　塗りつぶしなしの円（楕円）を配置。
 　名前を OvalA1,OvalA2,OvalB1,OvalB2 としたうえで、これらに Sheet1.Dlt をマクロ登録。

 こうして、円（楕円）をクリックしたり、A1～B2 をダブルクリックしてみてください。

（β） 2015/11/19(木) 16:42

β様

早急なご回答ありがとうございます。

一点ご質問させて下さい。

「名前を OvalA1,OvalA2,OvalB1,OvalB2 としたうえで、これらに Sheet1.Dlt をマクロ登録。」

の部分を詳しく教えてください。
（nitro） 2015/11/19(木) 16:54

β様

併せまして追加のご質問です。

A1：B2のセルをA3：B4にコピーして、同じ効果を期待したい場合、コードをいじる必要はありますか？

よろしくお願いいたします。
（nitro） 2015/11/19(木) 16:58

 別回答
 セルのダブルクリックで作成と削除

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Tshp As Object

    If Intersect(Target, Range("A1:B2")) Is Nothing Then Exit Sub

    Cancel = True

    For Each Tshp In Shapes
        If Target.Left = Tshp.Left Then
            If Target.Top = Tshp.Top Then
                Tshp.Delete
                Exit Sub
            End If
        End If
    Next

    With Shapes.AddShape(msoShapeOval, Target.Left, Target.Top, Target.Width, Target.Height)
        .Fill.Visible = msoFalse
    End With

 End Sub

（＿＿＿） 2015/11/19(木) 17:36

 まず、シートモジュールにコードを貼り付けます。

 で、４つの円（楕円）を選択して右クリック。
 マクロ登録を選び、Sheet1.Dlt （Sheet1の部分は、実際のシートコード名になっていますが）を選んでＯＫボタン。

 A3:B4 への範囲拡大も、基本的には同様にシェープ（名前の命名ルールは守ってください）を準備し、それらにマクロ登録。
 ただし、１か所、ダブルクリックされたセルをチェックしているところは変更必要です。

 If Intersect(Target, Range("A1:B2")) Is Nothing Then Exit Sub

 この A1:B2 を、拡張された範囲に変更して下さい。

（β） 2015/11/19(木) 17:46

＿＿＿様、β様

ご回答ありがとうございました。
おかげさまで解決できました！
また何かありましたら宜しくお願い致します。
（nitro） 2015/11/20(金) 10:41

コメント返信：

[ 一覧(最新更新順) ]

[[20151119155804]] 『セルをダブルクリックしてセル内の文字をオートシ』（nitro） ページの最後に飛ぶ

[[20151119155804]]　『セルをダブルクリックしてセル内の文字をオートシ』（nitro）　ページの最後に飛ぶ