| |
今回の投稿は、私のコードのコピペのミスや、タイトルの記入ミスで、多くの諸先輩方々に、ご迷惑をおかけしました。改めて、コードの方を添付させてもらいますので、是非、ご指導をお願いいたします。
---------------------------------------------------------------------------
----Sheet1に記載----
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Shape
Dim c As Long
For Each sh In ActiveSheet.Shapes
If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then
Call Module1.DelShape(Target)
Else
Call Module1.AddShape(Target)
End If
Next sh
End Sub
----Module1に記載----
Option Explicit
Sub AddShape(Target As Range)
Dim t As Single
Dim l As Single
Dim h As Single
Dim w As Single
Target.HorizontalAlignment = xlCenter
t = Target.Top
l = Target.Left
h = Target.Height
w = seru.Width
ActiveSheet.Shapes.AddShape(msoShapeDonut, l, t, w, h).Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End Sub
Public Sub DelShape(Target As Range)
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If Not Application.Intersect(Target, sh.TopLeftCell) Is Nothing Then
sh.Select
Selection.Delete
End If
Next sh
End Sub
|
|
じょにー
- 11/10/9(日) 18:24 -
