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

Private Sub ボタンに登録されているマクロ名をプリント確認する()
    Dim wsTarget As Worksheet
    Dim shpCurrent As Shape
    Dim strMacroName As String
    Dim strOutputDetail As String
    Dim strCaption As String

    Const MSO_OLE_CONTROL As Long = 12

    Set wsTarget = ActiveSheet

    Debug.Print String(60, "-")
    Debug.Print "「" & wsTarget.Name & "」シートに存在するマクロのつながりを探索"
    Debug.Print String(60, "-")

    ' 1. 取得しうるすべてのShapeを一つずつ巡る
    For Each shpCurrent In wsTarget.Shapes
        strMacroName = ""
        strCaption = ""
        strOutputDetail = ""

        With shpCurrent
            ' --- 図形の表示テキスト（キャプション）を安全に取得 ---
            On Error Resume Next
            ' ① OLEObjectの場合：OLEFormatを介してCaptionを取得
            If .Type = MSO_OLE_CONTROL Then
                strCaption = Replace(.OLEFormat.Object.Object.Caption, vbCrLf, "")
            Else
                ' ② 通常Shapeの場合：TextFrame2経由でキャプションを取得
                If .HasTextFrame Then
                    If .TextFrame2.HasText Then strCaption = .TextFrame2.TextRange.Text
                End If
            End If

            ' ③ フォームコントロール（ボタンやグループボックスなど）のキャプションを捕捉
            If .Type = 8 Then ' msoFormControl
                On Error Resume Next
                strCaption = .DrawingObject.Caption
            End If
        End With
        On Error GoTo 0 ' エラーハンドリングを元に戻す

        ' --- Shapeのタイプに基づいてマクロの紐づけ（OnAction/イベント）を探索 ---
        Select Case .Type
            Case MSO_OLE_CONTROL
                ' ActiveXコントロール（Type 12）
                On Error Resume Next
                strMacroName = .OLEFormat.Object.Object.OnAction
                If strMacroName = "" Then strMacroName = .Name & "_Click"
                strOutputDetail = _
                    vbTab & "■" & IIf(strCaption <> "", strCaption, "（キャプションなし）") & vbCrLf & _
                    vbTab & "　Type = ActiveXコントロール" & vbCrLf & _
                    vbTab & "　Shape Name = " & .Name & vbCrLf & _
                    vbTab & "　Macro Name = " & strMacroName & vbCrLf
            Case Else
                ' 通常のフォームボタン
                On Error Resume Next
                strMacroName = .OnAction
                strOutputDetail = _
                    vbTab & "■" & IIf(strCaption <> "", strCaption, "（キャプションなし）") & vbCrLf & _
                    vbTab & "　Type = " & .Type & vbCrLf & _
                    vbTab & "　Shape Name = " & .Name & vbCrLf & _
                    vbTab & "　Macro Name = " & strMacroName & vbCrLf
        End Select

        Debug.Print strOutputDetail
    Next shpCurrent
End Sub