Récupérer noms des macros dans un onglet

Option Explicit


Sub Liste()
    Dim o As Object, i&, t$, Nom$, Liste$(), n&, c As Range
    '---liste des procédures Sub---
    For Each o In ThisWorkbook.VBProject.VBComponents
        With o.CodeModule
            For i = 1 To .CountOfLines
                t = " " & Trim(.Lines(i, 1))
                Nom = .ProcOfLine(i, 0)
                If t Like "* Sub " & Nom & "(*)" Then
                    If t Like " Sub " & Nom & "()" Then
                        n = n + 1
                        ReDim Preserve Liste(1 To 2, 1 To n)
                        Liste(1, n) = o.Name    'nom du module
                        Liste(2, n) = Nom    'nom de la macro
                    End If
                    i = i + .ProcCountLines(Nom, 0) - 1    'saute les lignes
                End If
            Next
        End With
    Next
    '---RAZ---
    Application.ScreenUpdating = False
    [A2:B65536].ClearContents
    For Each o In Me.Shapes
        If o.TopLeftCell.Column = 3 Then o.Delete
    Next
    '---création de la liste et des boutons---
    If n Then
        With [A2:B2].Resize(n)
            .Value = Application.Transpose(Liste)
            .Sort [B2], Header:=xlNo    'tri
            For Each c In .Columns(2).Cells
                With Me.Buttons.Add(c(1, 2).Left, c.Top, c(1, 2).Width, c.Height)
                    .OnAction = c(1, 0) & "." & c
                    c = Replace(c, "_", " ")
                    .Characters.Text = c
                End With
            Next
        End With
    End If
End Sub

Option Explicit
'======================
Sub Liste_Sub()
Dim o As Object, i&, t$, Nom$, Liste$(), n&, c As Range
Dim Col%
 '--------- liste des procédures Sub -------
For Each o In ThisWorkbook.VBProject.VBComponents
     With o.codemodule
         For i = 1 To .CountOfLines
             t = " " & Trim(.Lines(i, 1))
             Nom = .ProcOfLine(i, 0)
             If t Like "* Sub " & Nom & "(*)" Then
                 If t Like " Sub " & Nom & "()" Then
                     n = n + 1
                     ReDim Preserve Liste(1 To 2, 1 To n)
                     Liste(1, n) = o.Name    'nom du module
                    Liste(2, n) = Nom        'nom de la macro
                End If
                 i = i + .ProcCountLines(Nom, 0) - 1  'saute les lignes
            End If
         Next
     End With
 Next
 '-------- Ajout Feuille --------
Sheets.Add
Col = 2
'----------- Affichage ----------
Cells(1, Col).Value = "Liste des SUB"
Cells(2, Col).Value = "Nom du Module"
Cells(2, Col + 1).Value = "Nom de la macro"
For i = 1 To n
    Cells(i + 2, Col).Value = Liste(1, i)
    Cells(i + 2, Col + 1).Value = Liste(2, i)
Next i
Range("B:C").EntireColumn.AutoFit
Range(Cells(1, Col), Cells(1, Col + 1)).Merge
Range(Cells(1, Col), Cells(2, Col + 1)).HorizontalAlignment = xlCenter
With Range(Cells(1, Col), Cells(2, Col + 1)).Borders
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
ActiveSheet.Delete
End Sub
'=======================

Sub Essai()
'Nécessite d'activer la référence
    'Microsoft "Visual basic For Application Extensibility 5.3"
Dim VBCmp As VBComponent
Dim cdMod As CodeModule
Dim Wb As Workbook
Dim Debut&

'---- Indiquez le nom du classeur ouvert ----
'Set Wb = Workbooks("Classeur1.xls")
Set Wb = ThisWorkbook
'Boucle sur tous les composantsdu projet :
    'Modules standards
    'Modules de feuilles et de classeur
    'Modules de classe
    'UserForms
For Each VBCmp In Wb.VBProject.VBComponents
    Set cdMod = VBCmp.CodeModule
'---------------------------
    With cdMod
        Debut = .CountOfDeclarationLines + 1
        Do Until Debut >= .CountOfLines
            'Nom de la procédure et du module
            Debug.Print VBCmp.Name & " / " & .ProcOfLine(Debut, vbext_pk_Proc)
            Debut = Debut + .ProcCountLines(.ProcOfLine(Debut, _
                vbext_pk_Proc), vbext_pk_Proc)
        Loop
    End With
'---------------------------
Next VBCmp
End Sub