Salut,

pour donner le pendant Excel du code évoqué ici
http://www.developpez.net/forums/d67...d-base-access/

voici une fonction qui analyse le code contenu dans un classeur Excel.

A noter que la prise en compte des tableaux est faite, et le cas de figure avec un commentaire dans la ligne en question, celui-ci est "supprimé".

Le résultat est mis dans une feuille Analyse_classeur avec la répartition suivante :
A : Emplacement du fichier Excel
B : Function ou Sub
C : Nom de la fonction/procédure
D : Liste des Paramètres
E : Type de retour (pour les fonctions)

En espérant que l'analyse de contenu VBA pourra être utile à certains d'entre nous
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Public Function Liste_Procedures_Fonctions_VBA_Excel(pathFichier As String) As Boolean
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Cible As String
Dim oExcel As New Excel.Application
 
On Error GoTo fin
 
 
    With oExcel
        .Visible = False
        .EnableEvents = False
        .Workbooks.Open (pathFichier)
    End With
 
    For i = 1 To oExcel.VBE.VBProjects(1).VBComponents.Count
        With oExcel.VBE.VBProjects(1).VBComponents.Item(i).CodeModule
        ' pour le remplacement d'une ligne entière
            For k = 1 To .CountOfLines
                Cible = Trim(.Lines(k, 1))
                'Debug.Print Cible
                If Left(Cible, 1) <> "'" Then
                    If InStrRev(Cible, "'") > 0 Then
                        Cible = Mid(Cible, 1, InStrRev(Cible, "'") - 1)
                    End If
                    If InStr(1, Cible, "Function ") > 0 Then
                        j = ThisWorkbook.Worksheets("analyse_classeur").Range("A65536").End(xlUp).Row + 1
                        With ThisWorkbook.Worksheets("analyse_classeur")
                            .Range("A" & j).Value = pathFichier
                            .Range("B" & j).Value = "Function"
                            .Range("C" & j).Value = RecupererTexteEntreBornes(Cible, "Function ", "(")
                            .Range("D" & j).Value = Trim(Mid(Cible, 1 + InStr(1, Cible, "("), InStrRev(Cible, ")") - InStr(1, Cible, "(") - 1)) 
                            If .Range("D" & j).Value = ")" Then
                                .Range("D" & j).Value = ""
                            End If
                            .Range("E" & j).Value = Mid(Cible, 1 + InStrRev(Cible, ") As ")) 'RecupererTexteEntreBornes(Cible, ") As ", "")
                        End With
                    End If
                    If InStr(1, Cible, "Sub ") > 0 Then
                        j = ThisWorkbook.Worksheets("analyse_classeur").Range("A65536").End(xlUp).Row + 1
                        With ThisWorkbook.Worksheets("analyse_classeur")
                            .Range("A" & j).Value = pathFichier
                            .Range("B" & j).Value = "Sub"
                            .Range("C" & j).Value = RecupererTexteEntreBornes(Cible, "Sub ", "(")
                            .Range("D" & j).Value = Trim(Mid(Cible, 1 + InStr(1, Cible, "("), InStrRev(Cible, ")") - InStr(1, Cible, "(") - 1)) 'RecupererTexteEntreBornes(Cible, "(", ")")
                            If .Range("D" & j).Value = ")" Then
                                .Range("D" & j).Value = ""
                            End If
 
                        End With
                        'CurrentDb.Execute "INSERT INTO T_LISTE_PROCEDURES (DB_PATH,FUNCTION_OR_SUB,NM_FUNCTION_OR_SUB,PARAM) VALUES ('" & pathbase & "','Sub','" & RecupererTexteEntreBornes(Cible, "Sub ", "(") & "','" & RecupererTexteEntreBornes(Cible, "(", ")") & "')"
                    End If
                End If
            Next k
        End With
    Next i
 
    oExcel.Quit
    Set oExcel = Nothing
 
    Liste_Procedures_Fonctions_VBA_Excel = True
Exit Function
 
fin:
    Liste_Procedures_Fonctions_VBA_Excel = False
    Resume Next
End Function
 
'Fonction utilisée pour récuperer un texte compris entre deux autres
'exemple : RecupererTexteEntreBornes("<html><body>Pioupi</body></html>","<body>","</body>")
'retournera Pioupi
Function RecupererTexteEntreBornes(texte As String, textedebut As String, textefin As String) As String
Dim result As String
Dim debut As Integer
Dim fin As Integer
    debut = InStr(1, texte, textedebut)
    fin = InStr(debut + Len(textedebut), texte, textefin)
    result = ""
    If debut > 0 Then
        If fin > debut + Len(textedebut) Then
            result = Mid(texte, debut + Len(textedebut), fin - debut - Len(textedebut))
        Else
            result = Right(texte, Len(texte) - debut - Len(textedebut) + 1)
        End If
    End If
    RecupererTexteEntreBornes = result
End Function