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 |
Partager