オートシェイプ同士をリンクさせる事は出来ますか？

質問

同シート内に、「１」と入力してある楕円のオートシェイプが２つあります。
どちらかをクリックすると、もうひとつのオートシェイプへ飛んでいける・・・
ようなことを、実現するにはどうしたらいいでしょうか？

ちなみに、シートが分かれることはありません。
オートシェイプは、１～５０ までの連番で、シート内に２つ存在します。

オートシェイプ同士をリンクさせる事は出来ますか？
広いシートの中で、同じ番号を見つけるのが大変なのです。
オートシェイプだと、検索に引っ掛かってくれないので。。

環境は、Windows2000　office2000　です。

ご教授の程、よろしくお願い致します。

回答No.3

mitarashi

オートシェープの名前は初期値のままである事を前提とします。
（当方XL2000ですので、上位バージョンで動かなかったらご容赦を）
#2さんのコードと違って、都度、全楕円をスキャンしますので、楕円の個数によっては遅いかもしれません。
Sub test()
Dim shp As Shape
Dim myShape As Shape

Set myShape = ActiveSheet.Shapes(Application.Caller)
For Each shp In ActiveSheet.Shapes
If InStr(shp.Name, "Oval") > 0 Then
If shp.Name <> myShape.Name Then
If shp.TextFrame.Characters.Text = myShape.TextFrame.Characters.Text Then
shp.TopLeftCell.Activate
'このへんはお好みで
'Application.Goto shp.TopLeftCell
'shp.select
Exit For
End If
End If
End If
Next shp
End Sub
以下はおまけ
全ての楕円に、上記マクロ「test」を設定
Sub setMacro()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If InStr(shp.Name, "Oval") > 0 Then shp.OnAction = "test"
Next shp
End Sub

回答No.2

DOUGLAS_

一例です。
　念のため、ダミー の ブック（当該ブック を複製）でお試しください。

１）[Alt] + [F11] で Visual Basic Editor（VBE）を開きます。
２）[挿入(I)] - [標準モジュール(M)] で開く コードウィンドウ に下記の コード を コピペ します。
'-----------------------------------------
Sub Rename()
　Dim Sh As Shape
　For Each Sh In ActiveSheet.Shapes
　　If Sh.AutoShapeType = msoShapeOval Then
　　　On Error Resume Next
　　　Sh.Name = "Oval" & Sh.DrawingObject.Text & "-1"
　　　If Error.Number = 70 Then
　　　　Sh.Name = "Oval" & Sh.DrawingObject.Text & "-2"
　　　End If
　　　On Error GoTo 0
　　　Sh.OnAction = "Select_Ovals"
　　End If
　Next
End Sub
Sub Select_Ovals()
　Dim Sh As String
　Sh = Application.Caller
　If Right(Sh, 1) = "1" Then
　　ActiveSheet.Shapes(Replace(Sh, "-1", "-2")).Select
　Else
　　ActiveSheet.Shapes(Replace(Sh, "-2", "-1")).Select
　End If
End Sub
'-----------------------------------------
３）[Alt] + [F4]　で VBE を閉じます。
４）[Alt] + [F8] で [マクロ] ダイアログ を開き、「Rename」を選択して [実行(R)] します。

　以上で、それぞれの オートシェイプ に「Oval{連番}-1」・「Oval{連番}-2」という名前が付きました。
　「Oval{連番}-1」を クリック すれば「Oval{連番}-2」に飛び、「Oval{連番}-2」を クリック すれば「Oval{連番}-1」に飛びます。

　なお、一連の作業が終了しましたら、（２）で書いた コード の内「Sub Rename()」の方は削除していただいて結構です。

回答No.1

temtecomai2

excel 2007 で試しましたがオートシェイプへのリンクはできませんでした。（正攻法では）

回避策として、ジャンプ先のオートシェイプが乗っかっているセル自体に名前を定義する方法はどうでしょうか。
ジャンプ元のセルのハイパーリンク設定で、[このドキュメント内] の [定義された名前] に出てくるのでジャンプ先を選択する。