AW: Makros per Makro zählen
06.03.2007 10:14:00
Heiko
Hallo Roland,
so könnte es dann aussehen.
Public Function ListMacrosWorkbook(wkbBook As Workbook, _
Optional RunTypesOnly As Boolean = True, Optional PublicOnly As Boolean = False)
' Function: List all macros in wkbBook
' Synopsis: Loops through the designated module processing
' each procedure by:
' - get the number of lines in the procedure
' - searches for the End statement in procedure
' to identify its line number
' - determines the procedure type
' - move onto next procedure
Dim oComponent As Object
Dim fStart As Boolean
Dim iStart As Long, iCurrent As Long
Dim cLines As Long, cProcs As Long
Dim sProcName As String
Dim lProcKind As Long
Dim aryProcs
ReDim aryProcs(1 To 3, 1 To 1)
For Each oComponent In wkbBook.VBProject.VBComponents
Debug.Print "___" & oComponent.Name
With oComponent.CodeModule
iStart = .CountOfDeclarationLines + 1
Do Until iStart >= .CountOfLines
'get the procedure name and count of line
'.ProcOfLine modifies ProcKind to type
sProcName = .ProcOfLine(iStart, lProcKind)
cLines = .ProcCountLines(sProcName, lProcKind)
Debug.Print "______" & sProcName
iCurrent = iStart - 1
Do
iCurrent = iCurrent + 1
fStart = .Lines(iCurrent, 1) Like "*Sub *" Or _
.Lines(iCurrent, 1) Like "*Function *" Or _
.Lines(iCurrent, 1) Like "*Property *"
Loop Until fStart
'determine procedure type
If .Lines(iCurrent, 1) Like "*Sub *" Or _
.Lines(iCurrent, 1) Like "*Function *" Then
If Not PublicOnly Or Not .Lines(iCurrent, 1) Like "*Private *" Then
If RunTypesOnly Then
If InStr(.Lines(iCurrent, 1), "()") Then
cProcs = cProcs + 1
ReDim Preserve aryProcs(1 To 3, 1 To cProcs)
aryProcs(1, cProcs) = wkbBook.Name
aryProcs(2, cProcs) = oComponent.Name
aryProcs(3, cProcs) = sProcName
End If
Else
cProcs = cProcs + 1
ReDim Preserve aryProcs(1 To 3, 1 To cProcs)
aryProcs(1, cProcs) = wkbBook.Name
aryProcs(2, cProcs) = oComponent.Name
aryProcs(3, cProcs) = sProcName
End If
End If
End If
'onto the next procedure
iStart = iStart + .ProcCountLines(sProcName, lProcKind)
Loop
End With 'oComponent
Next oComponent
ListMacrosWorkbook = aryProcs
End Function
' Aufruf z.B. so, schreibt die Liste in das aktive Tabellenblatt
Sub ListeAlleMakros()
Dim varBack() As Variant
Dim wkbB As Workbook
Dim i
' Name für die Datei natürlich anpassen !!! Die Datei muss ofen sein !!!
Set wkbB = Workbooks("EXCEL VBA Einführung.xls")
varBack = ListMacrosWorkbook(wkbB, False, False)
i = i * 1
ActiveSheet.Range(Cells(2, 1), Cells(UBound(varBack, 2), UBound(varBack, 1))) = _
Application.WorksheetFunction.Transpose(varBack)
ActiveSheet.Cells(1, 1) = "Anzahl aller Makros = " & UBound(varBack, 2) - 1
End Sub
Gruß Heiko
PS: Rückmeldung wäre nett !