Dim HyperlinkStack As Collection ‘マクロ外で設定
Dim ShapeAddressStack As Collection
Sub InitializeHyperlinkStack()
Set HyperlinkStack = New Collection
Set ShapeAddressStack = New Collection
End Sub
Sub StoreHyperlink() ‘飛んでくる元のボタンに登録するマクロ
If HyperlinkStack Is Nothing Then InitializeHyperlinkStack
Dim foundCell As Range
Dim searchString As String
searchString = "AAA()" ' 検索したい文字列を設定
' シート内を検索
Set foundCell = ActiveSheet.Cells.Find(What:=searchString, LookAt:=xlPart, MatchCase:=False)
' 見つかった場合、アドレスをスタックに追加してジャンプ
If Not foundCell Is Nothing Then
ShapeAddressStack.Add ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address
foundCell.Select
Else
MsgBox "指定された文字列が見つかりません。"
End If
End Sub
Sub HyperlinkBack() ‘戻るボタンに登録するマクロ
On Error GoTo ErrHandler
If ShapeAddressStack.Count > 0 Then
Range(ShapeAddressStack(ShapeAddressStack.Count)).Select
ShapeAddressStack.Remove ShapeAddressStack.Count
Else
MsgBox “元の図形の場所に戻ることができません。”
End If
Exit Sub
ErrHandler:
MsgBox “元の図形の場所に戻ることができません。”
End Sub