|
Option Explicit
Public Sub Start_KomponentenErmitteln()
Dim vbaProjekt As Object
Dim vbaKomponente As Object
Dim anzKomponenten As Integer
Dim vbaProzedur As Object
Dim prozedurName As String
Dim anzProzeduren As Integer
Dim zEndSub As String
Dim startZ As Long
Dim bodyZ As Long
Dim anzZ As Long
Dim anzC As Long
Dim z As Integer
Dim i As Integer
Dim j As Integer
anzKomponenten = 0
anzProzeduren = 0
z = 2
Set vbaProjekt = ActiveWorkbook.VBProject.VBComponents
For Each vbaKomponente In vbaProjekt
z = z + 1
Select Case vbaKomponente.Type
Case 1: Cells(z, 1) = "Modul"
Case 2: Cells(z, 1) = "Klassenmodul"
Case 3: Cells(z, 1) = "Formular"
Case 100: Cells(z, 1) = "Microsoft Excel Objekt"
End Select
Set vbaProzedur = vbaProjekt(vbaKomponente.Name).CodeModule
Cells(z, 2) = vbaKomponente.Name
anzKomponenten = anzKomponenten + 1
With vbaProzedur
For i = 1 To .CountOfLines
If .ProcOfLine(i, vbext_pk_Proc) <> "" Then
prozedurName = .ProcOfLine(i, vbext_pk_Proc)
anzProzeduren = anzProzeduren + 1
startZ = .ProcStartLine(prozedurName, vbext_pk_Proc)
bodyZ = .ProcBodyLine(prozedurName, vbext_pk_Proc)
anzZ = .ProcCountLines(prozedurName, vbext_pk_Proc)
For j = bodyZ To .CountOfLines
zEndSub = Trim(.Lines(j, 1))
If (Left(zEndSub, 7)) = "End Sub" Or _
(Left(zEndSub, 12)) = "End Function" Then
anzC = j - bodyZ + 1
Exit For
End If
Next
Cells(z, 3) = prozedurName
Cells(z, 4) = startZ
Cells(z, 5) = bodyZ
Cells(z, 6) = anzC
Cells(z, 7) = anzZ
z = z + 1
i = i + anzZ
End If
Next
End With
z = z + 1
Next
ActiveSheet.Columns("A:C").AutoFit
MsgBox "In der Arbeitsmappe '" & ActiveWorkbook.Name & _
"' sind " & vbCrLf & _
anzKomponenten & " Komponenten und " & _
anzProzeduren & " Prozeduren enthalten !", _
vbOKOnly + vbInformation, Title:="Komponenten ermitteln"
End Sub
|
|