オートシェイプの文字列検索マクロ－VBA

オートシェイプの文字列を検索するマクロを作成しました。

PowerPointやWordはオートシェイプの文字列ができるのに、Excelだけできません。

以下のコードを Excelアドイン(*.xlam) 形式で保存し、C:\Users\[ログインID]\AppData\Roaming\Microsoft\Excel\XLSTART(Win10) に置けば、どのエクセルファイルでもマクロが使えます。
クイックアクセスツールバーの先頭にするとalt+1で実行できます。

module1.bas

Option Explicit

Private Const TITLE_SEARCH_SHAPE_TEXT As String = "オートシェイプ検索"

Public Sub searchShapeText()
    
    Dim sh  As Worksheet
    Dim txt As String
    
    txt = InputBox("検索ワード", TITLE_SEARCH_SHAPE_TEXT)
    If (Len(txt) = 0&) Then
        GoTo ExitSub
    End If
    
    Set sh = ActiveSheet
    
    If Not (searchShapeString(sh.Shapes, txt)) Then
        MsgBox "「" & txt & "」が見つかりません", vbExclamation, TITLE_SEARCH_SHAPE_TEXT
    End If

ExitSub:
End Sub

Private Function searchShapeString(ByVal sps As Object, ByVal txt As String) As Boolean
    
    Dim sp  As Shape
    Dim s   As String
    Dim ret As Boolean
    Dim pos As Long
    
    ret = False
    For Each sp In sps
        If (sp.Type = msoGroup) Then
            If (searchShapeString(sp.GroupItems, txt)) Then
                ret = True
                GoTo ExitFunction
            End If

        ElseIf (sp.Type = msoComment) Then
            GoTo CONTINUE
            
'TextFrame2を持たないShapeがあれば以下のように除外する
'        ElseIf (sp.Type = msoGraphic) Then
'            GoTo CONTINUE

        Else
            If (sp.TextFrame2.HasText = msoTrue) Then
                s = sp.TextFrame2.TextRange.Text
                pos = InStr(s, txt)
                If (pos > 0&) Then
                    ActiveWindow.ScrollRow = sp.TopLeftCell.Row
                    ActiveWindow.ScrollColumn = sp.TopLeftCell.Column
                    
                    Do While (pos > 0&)
                        sp.TopLeftCell.Select 'テキスト範囲選択を解除するため、カレントセルを選択する
                        sp.TextFrame2.TextRange.Characters(pos, Len(txt)).Select
                        If (MsgBox("continue?", vbQuestion Or vbOKCancel, TITLE_SEARCH_SHAPE_TEXT) <> vbOK) Then
                            ret = True
                            GoTo ExitFunction
                        Else
                            pos = InStr(pos + 1&, s, txt)
                        End If
                    Loop
                    
                    GoTo CONTINUE
                End If
            End If
        End If
CONTINUE:
    Next
    
ExitFunction:
    searchShapeString = ret

End Function

ショートカットで実行する方法はこのあたりを参考にしてください。
自作マクロをクイックアクセスツールバーに登録する
クイックアクセスツールバーをショートカットにする

---

図形てんこ盛りの設計書~~エクセルで設計書！？~~で、文字列を目確したくないのでマクロ作成に踏み切ったわけですが、

でした。

Shape.GroupItems と WorkSheet.Shapes
両者ともShapeの集合なのに型が異なります。
インターフェースは共通かと思ったら、IShapesもIShapeRange違う。
searchShapeString の spsをObjectにしているのは、そういうことです。

PowerPointやWordはオートシェイプの文字列ができるのに、Excelだけ出来ないし、異なる場所にある同一ファイル名が開けないのもExcelだけ。

おまけ

クイックアクセスツールバーの設定

クイックアクセスツールバーに置くボタンを探すのは面倒ですよね
設定はexportできます。
下記はalt+1でマクロを起動する設定です。その他は自分用

Excel_customizations.exportedUI

<mso:cmd app="Excel" dt="0" />
<mso:customUI xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui">
  <mso:ribbon>
    <mso:qat>
      <mso:sharedControls>
        <mso:control idQ="mso:AutoSaveSwitch" visible="false"/>
        <mso:control idQ="mso:FileNewDefault" visible="false"/>
        <mso:control idQ="mso:FileOpenUsingBackstage" visible="false"/>
        <mso:control idQ="mso:FileSave" visible="false"/>
        <mso:control idQ="mso:FileSendAsAttachment" visible="false"/>
        <mso:control idQ="mso:FilePrintQuick" visible="false"/>
        <mso:control idQ="mso:PrintPreviewAndPrint" visible="false"/>
        <mso:control idQ="mso:Spelling" visible="false"/>
        <mso:control idQ="mso:Undo" visible="false"/>
        <mso:control idQ="mso:Redo" visible="false"/>
        <mso:control idQ="mso:SortAscendingExcel" visible="false"/>
        <mso:control idQ="mso:SortDescendingExcel" visible="false"/>
        <mso:control idQ="mso:PointerModeOptions" visible="false"/>
        <mso:button  idQ="x1:マクロファイルのパス_マクロ名_1" visible="true" onAction="マクロファイルのパス!マクロ名"/>
        <mso:control idQ="mso:ReadOnly" visible="true"/>
        <mso:control idQ="mso:ShapeChangeShapeGallery" visible="true"/>
        <mso:control idQ="mso:PictureSetTransparentColor" visible="true"/>
        <mso:control idQ="mso:PictureCropTools" visible="true"/>
        <mso:control idQ="mso:Camera" visible="true"/>
        <mso:control idQ="mso:SortClear" visible="true"/>
      </mso:sharedControls>
    </mso:qat>
    <mso:tabs>
      <mso:tab idQ="mso:TabDrawInk" visible="false"/>
    </mso:tabs>
  </mso:ribbon>
</mso:customUI>