AW: Makros(Sub's)in Kommentar
23.09.2009 18:05:09
fcs
Hallo Robert,
mit den folgenden Anpassungen gehts. Ob du die Deklarationen mit Ausgeben willst muss du halt selber entscheiden. Sie werden nicht mit der 1. Prozedur ausgegeben, sondern während des Durchlaufs durch den Modul-Code eingesammelt.
Gruß
Franz
Sub MakroListe()
Dim vbc As Object
Dim cmt As Comment
Dim iRow As Integer, iCol As Integer, iCounter As Integer
Dim sMacro As String
Dim sCode As String, sDeklaration As String
Cells.Clear
Rows(1).Font.Bold = True
For Each vbc In ThisWorkbook.VBProject.VBComponents
' For Each vbc In ActiveWorkbook.VBProject.VBComponents
sDeklaration = ""
iRow = 1
iCol = iCol + 1
Cells(iRow, iCol).Value = vbc.Name
With vbc.CodeModule
For iCounter = 1 To .CountOfLines
If .ProcOfLine(iCounter, 0) > "" Then
sMacro = .ProcOfLine(iCounter, 0)
iRow = iRow + 1
Cells(iRow, iCol).Value = sMacro
sCode = .Lines(iCounter, .ProcCountLines(sMacro, 0)) _
& vbLf & vbLf & "Aktualisierung: " & Now
sCode = Replace(sCode, vbCr, "")
With Cells(iRow, iCol)
If Not .Comment Is Nothing Then
.Comment.Delete
End If
Set cmt = .AddComment(sCode)
cmt.Shape.TextFrame.AutoSize = True
End With
iCounter = iCounter + .ProcCountLines(sMacro, 0) - 1
Else
sDeklaration = sDeklaration & vbLf & .Lines(iCounter, 1)
End If
Next iCounter
If sDeklaration "" Then
sDeklaration = "Deklarationen:" & sDeklaration
sDeklaration = Replace(sDeklaration, vbCr, "")
sDeklaration = sDeklaration & vbLf & vbLf & "Aktualisierung: " & Now
iRow = iRow + 1
With Cells(iRow, iCol)
.Value = "Deklarationen"
If Not .Comment Is Nothing Then
.Comment.Delete
End If
Set cmt = .AddComment(sDeklaration)
cmt.Shape.TextFrame.AutoSize = True
End With
End If
End With
Next vbc
Columns.AutoFit
End Sub