あなたの習慣について教えてください!!

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

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

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

環境は、Windows2000 office2000 です。


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

A 回答 (3件)

オートシェープの名前は初期値のままである事を前提とします。


(当方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
    • good
    • 0

 一例です。


 念のため、ダミー の ブック(当該ブック を複製)でお試しください。

1)[Alt] + [F11] で Visual Basic Editor(VBE)を開きます。
2)[挿入(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
'-----------------------------------------
3)[Alt] + [F4] で VBE を閉じます。
4)[Alt] + [F8] で [マクロ] ダイアログ を開き、「Rename」を選択して [実行(R)] します。

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

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

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

(正攻法では)

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報