Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

12141 / 76734

←次へ　｜　前へ→


	【70119】また、質問させて下さい

じょにー

- 11/10/16(日) 16:20 -


	引用なし

	パスワード

前回、kanabun様のご協力でダブルクリックしたセルにオートシェイプを描いたり、消したりするコードをご教授いただきましたが
別スレッドにて、UO3様にてEXECL2007での、シェイプの絵画方法をご伝授いただき、この２つを組み合わせて、自分なりに少し作ってみましたが
A1のセルに1が入っている時はダブルクリックした所に丸を描き
1以外なら2重丸を描いて、シェイプをダブルクリックすると消すと言う事をやってみようと思い下記の用なコードを書いてみましたが
丸の時は、ダブルクリックでちゃんと消えますが、2重丸の時はシェイプの選択になって消えません、どの様に手を加えたら良いのか、諸先輩方々の
お知恵を拝借出来れば幸いですセルの大きさは、列が2、行が16くらいでやっております。EXECL2007でのご指導を頂けると嬉しいです。
-----[Sheet1に記載]-----
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim sh As Shape
Dim c As Long
Dim flag As Boolean
Cancel = True
If Range("A1").Value = 1 Then
flag = True
Else
flag = False
End If
　
　　For Each sh In ActiveSheet.Shapes
　　　　If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then
　　　　　　Call Module1.DelShape(sh.Name)
　　　　　　Exit Sub
　　　　End If
　　Next sh
　　Call Module1.AddShape(Target, flag)
Target.Offset(1, 0).Select
End Sub
-----[Module1に記載]-----
Option Explicit

Public Sub AddShape(Target As Range, flag As Boolean)
　　If flag Then
　　With Target
ActiveSheet.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height).Select
　　End With
　　Selection.ShapeRange.Fill.Visible = msoFalse
　　With Selection.ShapeRange.Line
　　　 .ForeColor.ObjectThemeColor = msoThemeColorText1
　　　　.Visible = msoTrue
　　　　.Weight = 0.25
　　End With
　　Else
　　With Target
ActiveSheet.Shapes.AddShape(msoShapeDonut, .Left, .Top, .Width, .Height).Select
　　End With
　　Selection.ShapeRange.Fill.Visible = msoFalse
　　With Selection.ShapeRange.Line
　　　 .ForeColor.ObjectThemeColor = msoThemeColorText1
　　　　.Visible = msoTrue
　　　　.Weight = 0.25
　　End With
　　End If
　　End Sub

Public Sub DelShape(ShpName As String)
　　ActiveSheet.DrawingObjects(ShpName).Delete
End Sub

12 hits

▼

【70015】下記 じょにー 11/10/9(日) 16:32