|
初心者 さん、こんにちわ。
>その四角オートシェイプをコピーでもう1ヶ所に作り、2個目の四角オートシェイプを押すと1個目の四角オートシェイプの所に直線オートシェイプが出てくるのですが、2個目の四角オートシェイプの所に出てくるようにする事は可能なのでしょうか?
Application.Callerでどの図形から呼ばれたものかを分岐します。
Sub test()
Dim sh1 As Shape, sh2 As Shape, ws As Worksheet
Set ws = Application.ActiveSheet
'
If TypeName(Application.Caller) = "String" Then
'クリックされた図形をセットします
Set sh1 = ws.Shapes(Application.Caller)
'その図形の位置を基準に線(終点→)を引きます
With sh1
With ws.Shapes.AddLine(.Left + .Width, .Top + .Height \ 2, .Left + .Width * 2, .Top + .Height \ 2)
.Line.EndArrowheadLength = msoArrowheadLong
.Line.EndArrowheadWidth = msoArrowheadWide
.Line.EndArrowheadStyle = msoArrowheadStealth
End With
End With
Else
MsgBox "Clickで呼んでいない" '直接実行するとエラーになるので除外
End If
'
Set sh1 = Nothing: Set sh2 = Nothing
Set ws = Nothing
End Sub
こんな感じです。
分岐方法の詳細はCallerプロパティのヘルプを見てください。
四角形から横方向に→を出すマクロです。
オートシェイプの四角形をシートに置き、マクロを登録します。
その登録後の四角形をいろんなところにコピーしてクリックしてみてください。
|
|