| |
toshi さん、おはようございます。
>１回目は線を書き２回目のクリックで線をけすには
>どのような修正が必要なのでしょうか？
今回の質問はボタンが複数ということだったので、直線がボタンと関連しているかどうかを楽に判定するために、線を引くときに名前をつけました。
Sub test()
Dim sh1 As Shape, sh2 As Shape, sh3 As Shape, ws As Worksheet
Set ws = Application.ActiveSheet
'
If TypeName(Application.Caller) = "String" Then
'クリックされた図形をセットします
Set sh1 = ws.Shapes(Application.Caller)
'
For Each sh2 In ws.Shapes
If sh2.Name = "Line_" & sh1.Name Then
Exit For
End If
Next
If sh2 Is Nothing Then
'その図形の位置を基準に線（終点↑）を引きます
With sh1
'AddLineの引数の意味はヘルプで見てね
Set sh3 = ws.Shapes.AddLine(.Left + .Width / 2, .Top, .Left + .Width / 2, .Top - .Height)
With sh3
.Line.EndArrowheadLength = msoArrowheadLong
.Line.EndArrowheadWidth = msoArrowheadWide
.Line.EndArrowheadStyle = msoArrowheadStealth
End With
'
sh3.Name = "Line_" & sh1.Name '関連する名前を付けたら判定が楽かなあ
End With
Else
sh2.Delete
End If
Else
MsgBox "Clickで呼んでいない" '直接実行するとエラーになるので除外
End If
'
Set sh1 = Nothing: Set sh2 = Nothing: Set sh3 = Nothing
Set ws = Nothing
End Sub
これでどうでしょう？
複数の線を引く→消す場合は、あるかないかを判定後、消去もループで処理します。
また、表示を切り替えるだけなら、削除ではなくVisibleで切り替える方がいいと思います。
|
|
りん
- 07/3/30(金) 8:35 -
