マクロでオートシェイプを表示したいのですが（泣）

質問

マクロが理解できない初心者です。
エクセルで書類を作成しているのですが
「特定のセルに入力された文字列を
楕円のオートシェイプで囲む」といった要領で
分類する項目が大量にある書類を作成することになり
マクロの記録を使ってマクロを作成しようと試みたのですが
うまくいかず、困っています・・・
ＶＢＡなどで記入してマクロを作るということは
検索してわかったのですが
勉強する時間的余裕がありません・・・
どなたかご教授ください
おねがいします。

例
｜新規｜継続｜といった項目のどちらかを分類するために
囲みたいセルをダブルクリックすると
楕円のオートシェイプで項目の文字列を囲むいう感じです。

ダブルクリックするとシェイプが表示され
さらにダブルクリックすると非表示になるといったマクロが
できないでしょうか？

回答No.2

imogasi · ベストアンサー

下記はセルをダブルクリックで楕円などが現れます。
シート単位。従って
シートタブ部で右クリック。コードの表示、をクリック。
出てきた画面に貼り付け。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then 'A列ならば
lft = Target.Left + 2
tp = Target.Top + 2
hgt = Target.Height - 4
wdth = Target.Width - 4
'ActiveSheet.Shapes.AddShape(msoShapeOval, lft, tp, wdth, hgt).Select
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, lft, tp, wdth, hgt).Select
Selection.ShapeRange.Fill.Transparency = 0.85
Target.HorizontalAlignment = xlCenter
End If
End Sub
シートのＡ列のセルでダブルクリックすると、そこで楕円や角丸四角
が出る。
上記コードでＯｖａｌの行かShapeRoundedRectangleのどちらか好きなほうを残し、他をコメント化してください。
Ａ列限定の所は適当に列によって変える。Ａ列からの順番の数で指定。
＞勉強する時間的余裕がありません・・・
上記はマクロの記録を少々改造したもの。困っているのだろうから、やってみたが、上記ぐらいでもＶＢＡを多少自由に出来るようになるには数年かかるほどやはり大変なことだよ。

お礼

ありがとうございます。
＞上記ぐらいでもＶＢＡを多少自由に出来るようになるには数年かかる＞ほどやはり大変なことだよ。
本当に困っていたので大変助かりました。
時間を作って勉強します。
ありがとうございました。

回答No.3

mitarashi

皆さん消すのはどうやっているのかなとコードを見せていただきましたが、別の案をご参考までに。
１．ダブルクリックでセル内に楕円を描く
これはシートモジュールに記述（前の皆さんの説明をご参照下さい）
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
.Parent.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height).Select
End With
With Selection
.ShapeRange.Fill.Visible = msoFalse
.OnAction = "eraseShape"
End With
End Sub

２．消すときはダブルクリックではなく、クリックになってしまいますが、こちらは標準モジュールに記述してください。（Module1など）
Sub eraseShape()
ActiveSheet.Shapes(Application.Caller).Delete
End Sub

ただ、この様な目で見るしか判断できない印をつけて、どうやって情報を活用されるのか、心配です。自分なら、同時に別のセルに目印の値を入れるとかすると思います。

お礼

ありがとうございます。
締め切った後にご教授確認しました・・・
ポイントがつけられず申し訳ありません・・・
＞ただ、この様な目で見るしか判断できない印をつけて、どうやって
＞情報を活用されるのか、心配です。自分なら、同時に別のセルに
＞目印の値を入れるとかすると思います。
官公庁に届出する書類を作成する関係で
様式が決まっており、しかも毎回、数値データは変更されるといった
感じの書類なものでこのような無意味な作業に悩まされることに
なっています・・・
本当に困っていたので、とても助かりました。
ありがとうございました。

回答No.1

noname#102340

エクセルを開いてAlt + F11でエディタを開く
どこかにSheet1とか出てるので対象シートをダブルクリック(なかったら→表示→プロジェクトエクスプローラ)
出てきた画面の左のドロップダウンリストのWorksheetを選択。右のドロップダウンリストのBeforeDoubleClickを選択
Private Sub～End Subの間に下のコードを貼り付ける。

'ここから
Dim sp As Shape, w As Single, h As Single
For Each sp In ActiveSheet.Shapes
If sp.Name = Target.Address Then
sp.Delete
Exit Sub
End If
Next

Set sp = ActiveSheet.Shapes.AddShape(msoShapeOval, Target.Left, Target.Top, Target.Width, Target.Height)
sp.Fill.Visible = msoFalse
sp.Name = Target.Address
'ここまで

メモ
ダブルクリックが面倒ならBeforeRightClickを使う
消去のとき楕円の線に触れると図形を選択してしまうので中心を狙う
楕円のサイズを変えたいときは上のSet spの一行を消して下の三行に置き換える。w,hはてきとうにかえて。
オートシェイプの数が増えたときもさくさく動くかは未確認

w = 2
h = 2
Set sp = ActiveSheet.Shapes.AddShape(msoShapeOval, Target.Left - w, Target.Top - h, Target.Width + 2 * w, Target.Height + 2 * h)

お礼

ご教授ありがとうございます。
早速やってみます。
やっぱりむずかしいものですね・・・
不勉強な質問にお答えいただき感謝します。