' .
'CETTE ROUTINE DOIT ETRE DANS LE CLASSEUR CONCERNE !
'elle load ttes les routines de ce classeur SOIT "ThisWorkbook"
'et Save les résultats dans un Fichier.Doc dans le Rep Courant !
' .
'Cocher Référence "Microsoft Visual Basic For Application Extensibility 5.3"
' .
Public Sub SaveCodeMacroThisWorkbookDansFichDoc()
Dim VBCodeMod As CodeModule, Wbk As Workbook
Dim NbrDeRout As Integer, NbrDeRoutGlobal As Integer, NbrDeLigGlobal As Integer
Dim SwapValAlpha As String, SwapValNum As Integer
Set Wbk = ThisWorkbook
NbrDeComponent = Wbk.VBProject.VBComponents.Count
ReDim NomDeLaRout(1 To NbrDeComponent) As String, NbrDeLigRout(1 To NbrDeComponent) As Integer
For I = 1 To Wbk.VBProject.VBComponents.Count
NomDeLaRout(I) = Wbk.VBProject.VBComponents(I).Name
NbrDeLigRout(I) = Wbk.VBProject.VBComponents(I).CodeModule.CountOfLines
NbrDeLigGlobal = NbrDeLigGlobal + NbrDeLigRout(I)
Next
X = NbrDeComponent / 2 ' tri
Do While X
For A = 1 To NbrDeComponent - X
If NomDeLaRout(A) > NomDeLaRout(A + X) Then
SwapValAlpha = NomDeLaRout(A): NomDeLaRout(A) = NomDeLaRout(A + X): NomDeLaRout(A + X) = SwapValAlpha
SwapValNum = NbrDeLigRout(A): NbrDeLigRout(A) = NbrDeLigRout(A + X): NbrDeLigRout(A + X) = SwapValNum
For B = A - X To 1 Step -X
If NomDeLaRout(B + X) >= NomDeLaRout(B) Then Exit For
SwapValAlpha = NomDeLaRout(B): NomDeLaRout(B) = NomDeLaRout(B + X): NomDeLaRout(B + X) = SwapValAlpha
SwapValNum = NbrDeLigRout(B): NbrDeLigRout(B) = NbrDeLigRout(B + X): NbrDeLigRout(B + X) = SwapValNum
Next
End If
Next: X = X / 2
Loop
'save
Fich$ = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
Fich$ = "VBCode " & Fich$ & ".doc": NoF = FreeFile
Open Fich$ For Output As #NoF
Print #NoF, ThisWorkbook.Name
Print #NoF, "Nombre de Composants :"; NbrDeComponent
Print #NoF, "Nombre de Lignes Code :"; NbrDeLigGlobal
Print #NoF, "Nombre de Routines : en fin de liste..."
NbrDeRoutGlobal = 0
For I = 1 To NbrDeComponent
Set VBCodeMod = Wbk.VBProject.VBComponents(NomDeLaRout(I)).CodeModule
Print #NoF, ""
Print #NoF, "-- " & I & "'Composant -------------------- " & NomDeLaRout(I) & " ... " & NbrDeLigRout(I) & " Ligne(s)"
NbrDeRout = 0
With VBCodeMod
Ligne = .CountOfDeclarationLines + 1
Do Until Ligne >= .CountOfLines
NbrDeRout = NbrDeRout + 1
Z$ = .ProcOfLine(Ligne, vbext_pk_Proc): Print #NoF, NbrDeRout & ") " & Z$
Ligne = Ligne + .ProcCountLines(.ProcOfLine(Ligne, vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
NbrDeRoutGlobal = NbrDeRoutGlobal + NbrDeRout
Next
Print #NoF, ""
Print #NoF, "Nombre de Routines Global :"; NbrDeRoutGlobal
Close #NoF
MsgBox "Fichier " & Fich$ & vbLf & "Save " & CurDir
End Sub