GDIplusCODE

楕円をクリックすると、同じ文字の入った同一シート上の楕円にジャンプ

OKwaveで回答したけれど、VBA使用ではお気に召さなかったのか、音沙汰のなかったもの。
なかなか楽しい動作だと思うのですが。
たとえば、１という文字が入力された楕円の一方をクリックすると、シート上に
もう一個存在する、同じ文字が入った楕円にジャンプするというもの。何に使おう？


'楕円をクリックすると実行されるコード
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