Hallöchen, ich konnte nun den "Fehler" ausbügeln.
Im Anschluss der gesamte Code.
WICHTIG(!):
Es gilt folgendes zu beachten.
Es dürfen - in dieser aktuellen Version - keine Leerzeilen zwischen den einzelnen Prozeduren vorhanden sein.
Es können weitere Parameter, Informationen "herausgezogen" werden. Am besten einfach vorhanden Type
ProcedureInformations erweitern und die Funktion
GetInfosFromModule ergänzen.
Man könnte auch die Sub MODULES_ListMacrosToSheet als Funktion umwandeln, um zur Laufzeit gezielter einzelne Inforamtionen, Eigenschaften herauszuziehen.
Code: Alles auswählen
'-------------------------------------------------------------
'
' @purpose: populate all Macros with extended Infor-
' mations like Type, Name, Scope etc. into a
' specific Worksheet
' @params: -
' @author: thowe
' @deprecated: -
' @version: 0.0.1
' @source: inspired by and Thanks to:
' Joe Was, Chip Pearson
' https://www.mrexcel.com/board/threads/how-list-module-numbers-names-of-macros-in-ea-module.144151/
' https://groups.google.com/g/microsoft.public.excel.programming/c/bOv1hiGj28M?pli=1
' @module: modModules
' @ notes: You will need to create a reference to
' MS VBA Extensibilty 5.3
' (in VBE go to Tools>References)
' to work this code
' @ATTENTION(!) Please concatenate the individuale Pro-
' cedures in a Module. There should be no
' blankline between the Procuderes. If, then
' the Code runs into an Error.
' @date 18.03.2024
'
'-------------------------------------------------------------
' _ _ ___ _ _
' | |__ ___| |__ ( _ ) | |_| |__ _____ _____
' | '_ \ / _ \ '_ \ / _ \/\ | __| '_ \ / _ \ \ /\ / / _ \
' | | | | __/ |_) | | (_> < | |_| | | | (_) \ V V / __/
' |_| |_|\___|_.__/ \___/\/ \__|_| |_|\___/ \_/\_/ \___|
'
'-------------------------------------------------------------
'
' feel free to visit: https:vbasteleien.de
'
'-------------------------------------------------------------
Sub MODULES_ListMacrosToSheet()
Dim wksSheet As Worksheet 'the targeted Worksheet where to populate the data
Dim objProjectModule As Object 'the VBA Project
Dim vbCodeModule As CodeModule 'CodeModules
Dim intCounter As Integer 'inernal Counter
Dim ProcKind As VBIDE.vbext_ProcKind
Dim lngStartLine As Long
Dim lngRow As Long
Dim strProcName As String
Dim strProcedureType As String
Dim typProcInfos As ProcedureInformations
'initialize
Set wksSheet = ThisWorkbook.Worksheets("Sheet1")
lngRow = 1
wksSheet.Range("A:C").ClearContents
intCounter = 0
'The List's Column Labels in the WorkSheet.
With wksSheet
.Cells(lngRow, 1) = "Module Name"
.Cells(lngRow, 2) = "Type of Procedure"
.Cells(lngRow, 3) = "Macro/Procedure/Function Name"
End With
'Get Modules.
For Each objProjectModule In Application.VBE.ActiveVBProject.VBComponents
Set vbCodeModule = Application.ActiveWorkbook.VBProject.VBComponents(objProjectModule.Name).CodeModule
With vbCodeModule
'Index the module's name!
lngStartLine = .CountOfDeclarationLines + 1
Do Until lngStartLine >= .CountOfLines
'Increase Row for each listing!
lngRow = lngRow + 1
'get the Declarationinformations belonging to:
' Type like Sub, Function, Property, unknown
'Scope etc.
typProcInfos = MODULES_GetInfosFromModule(vbCodeModule, lngStartLine)
'populate the data into the Cells
'the Modulname
wksSheet.Cells(lngRow, 1) = objProjectModule.Name
wksSheet.Cells(lngRow, 2) = typProcInfos.ProcedureType
wksSheet.Cells(lngRow, 3) = typProcInfos.ProcedureName
'Call the SubFunction as a trial
' lngStartLine = lngStartLine + .ProcCountLines(.ProcOfLine(lngStartLine, ProcKind), ProcKind)
lngStartLine = lngStartLine + .ProcCountLines(.ProcOfLine(lngStartLine, typProcInfos.ProcedureKind), typProcInfos.ProcedureKind)
Loop
End With
Next objProjectModule
'Some Styling issues
wksSheet.Range("A:B").Columns.AutoFit
End Sub
Sub TestSomethingByVal(ByVal wks As Worksheet)
End Sub
Function MODULES_GetInfosFromModule(modModule As VBIDE.CodeModule, lngLineNumber As Long) As ProcedureInformations
'Declarations
Dim strProcedureHeader As String
Dim strTempHeader() As String
Dim typProcInfos As ProcedureInformations
Const strDefault As String = "default"
With modModule
strProcedureHeader = .Lines(lngLineNumber, 1)
'typProcInfos.ProcedureName = .ProcOfLine(lngLineNumber, vbext_pk_Proc)
typProcInfos.ProcedureName = .ProcOfLine(lngLineNumber, typProcInfos.ProcedureKind)
'later maybe further Declarations, Inforamtions
End With
strTempHeader = Split(strProcedureHeader, Space(1))
'Quick & dirty Exit if last Procudure in Module
On Error Resume Next
Select Case typProcInfos.ProcedureKind
Case VBIDE.vbext_pk_Get
Select Case LCase(strTempHeader(0))
Case "public", "private"
typProcInfos.ProcedureType = strTempHeader(0)
Case Else
typProcInfos.ProcedureType = strDefault
End Select
Case VBIDE.vbext_pk_Let
typProcInfos.ProcedureType = "Property Let"
Select Case LCase(strTempHeader(0))
Case "public", "private", "friend"
typProcInfos.ProcedureScope = strTempHeader(0)
Case Else
typProcInfos.ProcedureScope = strDefault
End Select
Case VBIDE.vbext_pk_Set
typProcInfos.ProcedureType = "Property Set"
Select Case LCase(strTempHeader(0))
Case "public", "private", "friend"
typProcInfos.ProcedureScope = strTempHeader(0)
Case Else
typProcInfos.ProcedureScope = strDefault
End Select
'Sub
Case VBIDE.vbext_pk_Proc
Select Case LCase(strTempHeader(0))
Case "public", "private", "friend"
typProcInfos.ProcedureScope = strTempHeader(0)
typProcInfos.ProcedureType = strTempHeader(1)
Case Else
typProcInfos.ProcedureScope = strDefault
typProcInfos.ProcedureType = strTempHeader(0)
End Select
End Select
MODULES_GetInfosFromModule = typProcInfos
End Function
Public Type ProcedureInformations
ProcedureName As String 'Name of the Proceudre
ProcedureType As String 'Sub, Function, Property, Class and so on
ProcedureScope As String 'Public, Private
ProcedureKind As VBIDE.vbext_ProcKind
End Type
Das folgende Snippet geht durch alle Componenten, UserForms, Controls und Module und zeigt deren Namen, Typ und Prozeduren ...