|
▼りん さん:
こんにちわ
わがままな質問に答えていただきありがとうございました。
思い通りの動きです。
感激です。
また、お願いします。
>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で切り替える方がいいと思います。
|
|