Alle Prozedur-/Makronamen auflisten |
|
Dieses Beispiel soll zeigen, wie sich alle Module und Prozeduren, so wie sie über die Entwicklungsumgebung (VBA-IDE) zu sehen sind, namentlich ermittelt werden können. Als Ergebnis werden diese strukturiert in ein neues Dokument geschrieben.
Zur Ermittlung werden nacheinander alle Projekte (VBProjects-Einträge) durchlaufen.
Diese entsprechen
den obersten Einträgen im Projekt-Explorer der IDE und stellen alle geöffneten und geladenen Dokumente, Vorlagen und Add-Ins dar. Der Deklarationsbereich, also der Bereich vor der ersten Prozedur, in der prozedurübergreifende Deklarationen oder Definitionen erfasst werden, kann direkt mit einer eigenen Methode erfasst werden. Dazu steht die CountOfDeclarationLines-Methode zur Verfügung, die die Gesamtzeilenzahl dieses Bereiches zurückliefert. Da aber auch Leerzeilen miterfasst werden, wird der Deklarationsbereich nur berücksichtigt, wenn er nicht nur aus Leerzeilen besteht. Die so gesammelten Informationen werden abschließend in ein neues Dokument geschrieben. Wichtig: Microsoft Visual Basic for Applications Extensibility 5.3
gesetzt sein! Update: Option Explicit Sub ListMacros() Dim oApp As Word.Application Dim myProject As VBProject Dim myComponent As VBComponent Dim strNames As Variant, strDocNames As String Dim strFile() As String Dim iCount As Long Dim strProc As String Set oApp = GetObject(, "Word.Application") ' Alle Projekte durchlaufen For Each myProject In VBE.VBProjects strNames = "" ' Nur ungeschützte berücksichtigen If myProject.Protection = vbext_pp_none Then On Error Resume Next If myProject.VBComponents.Count > 1 Then strFile() = Split(myProject.FileName, "\") strNames = strNames & myProject.Name & " (" & _ strFile(UBound(strFile())) & ")" & vbCrLf On Error GoTo 0 ' Alle Module durchlaufen For Each myComponent In myProject.VBComponents With myComponent ' Modul-Typ ermitteln If .Type = vbext_ct_StdModule Then strNames = strNames & vbTab & .Name & vbTab & " (bas)" & vbCrLf ElseIf .Type = vbext_ct_ClassModule Then strNames = strNames & vbTab & .Name & vbTab & " (cls)" & vbCrLf ElseIf .Type = vbext_ct_MSForm Then strNames = strNames & vbTab & .Name & vbTab & " (frm)" & vbCrLf ElseIf .Type = vbext_ct_Document Then strNames = strNames & vbTab & .Name & vbTab & " (doc)" & vbCrLf End If ' Declaration auslesen If .CodeModule.CountOfDeclarationLines > 0 Then For iCount = 1 To .CodeModule.CountOfDeclarationLines If .CodeModule.Lines(iCount, 1) <> "" Then strNames = strNames & vbTab & vbTab & "Declaration" & vbTab & " (" & _ .CodeModule.CountOfDeclarationLines & " Z.)" & vbCrLf Exit For End If Next iCount End If ' Prozeduren auslesen strProc = "" For iCount = 1 To .CodeModule.CountOfLines If .CodeModule.ProcOfLine(iCount, vbext_pk_Proc) <> strProc Then strProc = .CodeModule.ProcOfLine(iCount, vbext_pk_Proc) strNames = strNames & vbTab & vbTab & strProc & vbTab & " (" & _ .CodeModule.ProcCountLines(strProc, vbext_pk_Proc) & " Z.)" & vbCrLf End If Next iCount End With Next myComponent 'MsgBox strNames strDocNames = strDocNames & strNames & vbCrLf End If End If Next myProject ' In Dokument ausgeben Dim oDoc As Document Set oDoc = Documents.Add oDoc.Range.InsertAfter strDocNames End Sub |
Besucher: 0 online | 0 heute | 0 diesen Monat | 717307 insgesamt | Seitenaufrufe: 9 | Letzte Änderung: 10.08.2018 | © 2001-18 Christian Freßdorf | ||||
Es gibt mehr Leute, die kapitulieren, also solche, die scheitern. Henry Ford |
powered by phpCMS and PAX |