Excel VBA 複数の図形(オートシェイプ)内の文字列を一覧化してリンクを作成する方法

複数の図形(オートシェイプ)内の文字列を一覧化してリンクを作成する方法

やりたい事

「図形」シートにある複数の図形から情報を取得して

「図形リスト」シートに一覧として出力します。

マクロを実行した結果は以下のようになります。Linkを押下すると「図形」シートのそれぞれの図形にジャンプします。

サンプルコード

まずは「図形」シートに図形を作成する事前準備のマクロが以下になります。

Sub 事前準備()
    
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("B2").Left, Range("B2").Top, 100, 100).Name = "a"
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("D2").Left, Range("D2").Top, 100, 100).Name = "b"
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("B10").Left, Range("B10").Top, 100, 100).Name = "c"
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("D10").Left, Range("D10").Top, 100, 100).Name = "d"
    
    ActiveSheet.Shapes("a").TextFrame.Characters.text = "いるか"
    ActiveSheet.Shapes("b").TextFrame.Characters.text = "うさぎ"
    ActiveSheet.Shapes("c").TextFrame.Characters.text = "ぺんぎん"
    ActiveSheet.Shapes("d").TextFrame.Characters.text = "シャチ"
    
End Sub

以下が図形の情報を一覧化するマクロです。

Sub searchShapesTextList()
    
    Dim i As String: i = 2
    Dim workShape As Shape
    Set ws = Worksheets("図形リスト")
    
    For Each workShape In ActiveSheet.Shapes
        
        ws.Cells(i, 1) = workShape.Name
        ws.Cells(i, 2) = workShape.TextFrame.Characters.text
        ws.Hyperlinks.Add _
            anchor:=ws.Cells(i, 3), _
            Address:="", _
            SubAddress:="図形!" & workShape.TopLeftCell.Address, _
            TextToDisplay:="Link"
        i = i + 1
    Next
End Sub