【VBA】ボタンに登録されているマクロ名を調べたい

Private Sub ボタンに登録されているマクロ名をプリント確認する()
    ' ワークシート上の図形やボタンに登録されたマクロ名をリストアップする。
    ' F5キーで実行。対象シートをアクティブにしておく。

    Dim wsTarget As Worksheet
    Dim shpCurrent As Shape ' シート上の個々の描画オブジェクト
    Dim strMacroName As String
    Dim strOutputDetail As String ' Debug.Printに出力する整形済み文字列
    Dim strCaption As String ' 図形やボタンの表示テキスト
    
    '// ActiveXコントロールのTypeは msoOLEControlObject (Type 12)
    Const MSO_OLE_CONTROL As Long = 12
    
    '// シートを設定
    Set wsTarget = ActiveSheet
    
    Debug.Print String(60, "-")
    Debug.Print "「" & wsTarget.Name & "」シートに存在するマクロのつながりを探索"
    Debug.Print String(60, "-")
    
    '// シートに散りばめられた全てのShapeを一つ一つ巡る
    For Each shpCurrent In wsTarget.Shapes
        ' 変数の初期化
        strMacroName = ""
        strCaption = ""
        strOutputDetail = ""
        
        With shpCurrent
            
            '// キャプション（表示テキスト）を、エラーを恐れず、堅牢に取得する試み
            On Error Resume Next ' エラー発生を一時的に許容
            If .Type = MSO_OLE_CONTROL Then
                ' ActiveXコントロールの場合: OLEObjectを介してCaptionを取得
                strCaption = Replace(.OLEFormat.Object.Object.Caption, vbCrLf, "")
            Else
                ' その他の図形・コントロールの場合: TextFrame2経由でキャプションを取得
                If .HasTextFrame Then
                    strCaption = .TextFrame2.TextRange.Text
                End If
                
                ' フォームコントロールのボタンやグループボックスのキャプションを捕捉
                If .Type = 8 Then ' msoFormControl (フォームコントロールのグループボックスなど)
                    ' DrawingObjectが存在し、Captionプロパティを持つ可能性を考慮
                    ' フォームボタンの場合は.OLEFormat.Object.Captionでも取得可能だが、図形として処理
                    strCaption = .DrawingObject.Caption
                End If
                
            End If
            On Error GoTo 0 ' エラーハンドリングを元に戻す
            
            '// Shapeのタイプに基づいてマクロの結びつき（OnAction/イベント名）を探す
            Select Case .Type
            
                Case MSO_OLE_CONTROL ' ActiveXコントロール (Type 12)
                    ' OnActionは使えない。シートモジュール内のオブジェクト名_Clickイベントを推測
                    strMacroName = .Name & "_Click"
                    
                    strOutputDetail = _
                            "【Name】" & IIf(strCaption <> "", strCaption, "（キャプションなし）") & vbCrLf & _
                            vbTab & "◇ Type        : ActiveXコントロール" & vbCrLf & _
                            vbTab & "◇ Shape Name : " & .Name & vbCrLf & _
                            vbTab & "◇ Macro Name : " & strMacroName & " （シートモジュール内）" & vbCrLf
                    
                Case Else ' 通常の図形、フォームコントロールなど
                    ' OnActionプロパティにマクロ名が直接設定されているかを確認
                    strMacroName = .OnAction
                    If strMacroName = "" Then strMacroName = "（なし）"
                    
                    strOutputDetail = _
                            "【Name】" & IIf(strCaption <> "", strCaption, "（キャプションなし）") & vbCrLf & _
                            vbTab & "◇ Type        : その他（図形/フォームC）" & vbCrLf & _
                            vbTab & "◇ Shape Name : " & .Name & vbCrLf & _
                            vbTab & "◇ Macro Name : " & strMacroName & vbCrLf
                    
            End Select
            
            Debug.Print strOutputDetail
        
        End With
    Next shpCurrent
    
    Debug.Print String(60, "-")
    Debug.Print "探索完了"
    Debug.Print String(60, "-")

End Sub