複数違う元から飛んできても元へ戻れるマクロ+飛び先は文字列検索でヒットした先だから、編集で位置が変わってもOK!(ただし同じシート内)

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

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です