Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1548to1552
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Alle Codes der aktiven Mappe auflisten

Alle Codes der aktiven Mappe auflisten
26.03.2017 11:18:58
Dieter(Drummer)
Guten Tag VBA Spezialisten,
ich habe in der PersonL.xlsb den Code für die Auflistung aller Codes, die in der aktiven Mappe sind (Code aus Herber's Forum).
Dieser Code funktionert, wenn er in der aktiven Mappe ist, denn nur diese Codes sollen aufgelistet werden.
Wie muss der Code lauten, dass er in der PersonL.xlsb bleibt und nicht erst in die aktive Mappe eingefügt werden muss, damit die Codes der aktiven Mappe aufgelistet werden?
Hier der bisherige Code:
Sub MakroListe()
Dim ws As Worksheet, vbc As Object, _
iRow As Long, iCol As Integer, sMacro As String
Dim n1 As Long, n2 As Long, n3 As Long
Set ws = ThisWorkbook.Sheets.Add
ws.Cells.Clear
iCol = 0
For Each vbc In ThisWorkbook.VBProject.VBComponents
Debug.Print vbc.name
iRow = 1
iCol = iCol + 1
With vbc.CodeModule
With ws.Cells(iRow, iCol)
.Value = vbc.name
.Font.Bold = True
.Font.Italic = True
.name = "Calibri"
.Font.Size = 14
End With
n1 = 1
n2 = vbc.CodeModule.CountOfLines
For n3 = n1 To n2
sMacro = vbc.CodeModule.Lines(n3, 1)
If Trim(sMacro)  "" Then
'keine Leerzeilen
ws.Cells(iRow, iCol).Value = sMacro
iRow = iRow + 1
If InStr(1, sMacro, "End Sub", vbTextCompare) > 0 Then
iRow = iRow + 1
ElseIf InStr(1, sMacro, "End Function", vbTextCompare) > 0 Then
iRow = iRow + 1
ElseIf InStr(1, sMacro, "End Property", vbTextCompare) > 0 Then
iRow = iRow + 1
Else
End If
End If
Next n3
End With
Next vbc
ws.Columns.AutoFit
Set ws = Nothing
Set vbc = Nothing
MsgBox "F e r t i g!", 48 + vbSystemModal, "Hurra..."
End Sub

Mit Gruß,
Dieter(Drummer)

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Dann musst Du...
26.03.2017 11:38:02
Case
Hallo Dieter, :-)
... beide "ThisWorkbook" durch "ActiveWorkbook" ersetzen. ;-)
Servus
Case

AW: Danke Ralf (Case), das war's ...
26.03.2017 11:57:23
Dieter(Drummer)
... und es ist funktioniert perfekt.
Herzlichen Dank und Gruß,
Dieter(Drummer)
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige