Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
716to720
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
716to720
716to720
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

vbacode ausdrucken

vbacode ausdrucken
13.01.2006 12:57:08
Reinhard
Hallo,
im Editor kann ich ja nur zwischen dem Ausdruck eines Moduls oder des ganzen Projekts wählen.
Zur Fehlersuche möchte ich aber bestimmte Module auswählen und nur diese ausdrucken.
Google und Recherch brachten mich nicht weiter.
Da ich den Modulnamen kenne, bzw durch nachfolgenden Code ermitteln kann, langt mir der Code wie ich ein Modul durch Angabe seines Namens ausdrucken lassen kann.
Danke ^ Gruß
Reinhard
Option Explicit
Sub tt()
Dim i, zei
For i = 1 To ThisWorkbook.VBProject.VBComponents.Count
zei = zei + 1
Cells(zei, 1) = ThisWorkbook.VBProject.VBComponents(i).Name
Next i
End Sub

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Schliesse mich gerne dieser Frage an :-)
13.01.2006 13:57:48
urs
Hallo Reinhard
Du hast diese Frage vorzüglich formuliert. Ich bin auch interessiert daran.
Gruss urs
AW: Schliesse mich gerne dieser Frage an :-)
ransi
Hallo
MAl als ansatz zum weitergrübeln:
Option Explicit

Sub tt()
Dim i As Integer
For i = 1 To 50'bis Zeile 50
'evtl noch ne If abfrage auf ="" vorschalten.
Cells(i, 1) = ThisWorkbook.VBProject.VBComponents("Tabelle2").CodeModule.Lines(i, 1)
Next
End Sub

das ganze in ein Temporäres sheet, ausdrucken, sheet wiederlöschen.
sollte gehn.
ransi
AW: Schliesse mich gerne dieser Frage an :-)
13.01.2006 17:00:41
Reinhard
Hallo urs,
dank peter klappt es jetzt. nachfolgender Code listet die Module einer anderen Datei auf.
Gruß
Reinhard
Option Explicit
Public bolFound As Boolean
Public wb As String
Sub test2()
Dim i As Integer, zei As Integer
Dim objWks As Object
Application.ScreenUpdating = False
Range("A1:C1").EntireColumn.Clear
Set objWks = ThisWorkbook.Sheets("Tabelle1")
wb = "kilahukwiss.xls"
Workbooks.Open CurDir & "\" & wb
For i = 1 To Workbooks(wb).VBProject.VBComponents.Count
Call ExCode(Workbooks(wb).VBProject.VBComponents(i).Name, objWks)
Next i
ActiveWorkbook.Close
'If bolFound Then Sheets("Tabelle1").PrintOut
Application.ScreenUpdating = False
End Sub
Sub ExCode(strModulName As String, objTB As Object)
Dim intZ As Long, zei As Long
Dim strArr
bolFound = False
With Workbooks(wb).VBProject
For intZ = 1 To .VBComponents.Count
If strModulName = .VBComponents(intZ).Name Then bolFound = True
Next
If bolFound Then
ReDim strArr(0 To .VBComponents(strModulName).CodeModule.CountOfLines - 1)
For intZ = 1 To .VBComponents(strModulName).CodeModule.CountOfLines
strArr(intZ - 1) = _
.VBComponents(strModulName).CodeModule.Lines(intZ, 1)
Next
Else
MsgBox "Es wurde kein Modul mit dem Namen (" & strModulName & ") gefunden" _
, vbCritical, "Vorgang abgebrochen !"
End If
End With
With objTB
zei = .Range("A65536").End(xlUp).Row + 1
.Cells(zei + 1, 1) = "*************************************************************************"
.Cells(zei + 2, 1) = strModulName
For intZ = 1 To UBound(strArr)
.Cells(zei + 3 + intZ, 1) = strArr(intZ - 1)
Next
.Columns.AutoFit
End With
End Sub

Anzeige
AW: Schliesse mich gerne dieser Frage an :-)
13.01.2006 17:25:09
Peter
Servus,
freut mich wenn´s klappt. Kleine Anmerkung noch, da du ja eh alle Module auflistest, kannst du dir in der Sub ExCode die Überprüfungsschleife eigentlich sparen.
Nur wenns zuviele sind, zwecks Perform.
MfG Peter
Code läuft jetzt
13.01.2006 21:09:11
Reinhard
Hi urs,
vielleicht bist du ja daran interessiert:
Die Auflistung wird auf Blatt2 Duckfertig zubereitet um möglichst immer gesamtcode auf einem Blatt zu haben.
Gruß
Reinhard
Option Explicit
Public wb As String
Public Const Sterne = "*************************************************************************"
Sub test2()
Dim i As Long, zei As Long
Dim objWks As Object
Application.ScreenUpdating = False
Range("A1:C1").EntireColumn.Clear
Set objWks = ThisWorkbook.Sheets("Tabelle1")
wb = "kilahukwiss.xls"
Workbooks.Open CurDir & "\" & wb
For i = 1 To Workbooks(wb).VBProject.VBComponents.Count
Call ExCode(Workbooks(wb).VBProject.VBComponents(i).Name, objWks)
Next i
ActiveWorkbook.Close
zei = objWks.Range("A65536").End(xlUp).Row
objWks.Cells(zei, 1) = "End Sub" 'k.A. warum, das letzte End sub fehlt *g
objWks.Range("A1").Select
Call Druckfertig2
Application.ScreenUpdating = True
End Sub
Sub Druckfertig2()
Dim Druckzeilen As Integer, ende As Long, n As Long, anz As Integer, von(), bis(), pos2 As Long
Dim ws2 As Worksheet, anz2 As Integer
Druckzeilen = 56 'Arial10, 11=50, 12=47
Set ws2 = Worksheets("Tabelle2")
pos2 = 1
With Worksheets("Tabelle1")
ende = .Range("A65536").End(xlUp).Row
For n = 1 To ende
If Cells(n, 1) = Sterne Then
anz = anz + 1
ReDim Preserve von(anz)
von(anz) = n
End If
Next n
ReDim bis(anz)
For n = 1 To anz - 1
bis(n) = von(n + 1) - 1
Next n
bis(n) = ende
For n = 1 To anz - 1
anz2 = 0
While bis(n) - von(n) + 1 > Druckzeilen
.Range(Cells(von(n), 1), Cells(von(n) + Druckzeilen - 1, 1)).Copy ws2.Cells(pos2, 1)
pos2 = pos2 + Druckzeilen
von(n) = von(n) + Druckzeilen
Wend
If .Cells(von(n), 1) <> Sterne Then
.Range(Cells(von(n), 1), Cells(bis(n)), 1).Copy ws2.Cells(pos2, 1)
pos2 = pos2 + Druckzeilen
End If
While bis(n) - von(n) + bis(n + 1) - von(n + 1) + 2 < Druckzeilen
n = n + 1
von(n) = von(n - 1)
Wend
.Range(Cells(von(n), 1), Cells(bis(n), 1)).Copy ws2.Cells(pos2, 1)
pos2 = pos2 + Druckzeilen
Next n
If von(n) <> von(n - 1) Then .Range(Cells(von(n), 1), Cells(bis(n), 1)).Copy ws2.Cells(pos2, 1)
.Columns.AutoFit
End With
End Sub
Sub ExCode(strModulName As String, objTB As Object)
Dim intZ As Long, zei As Long
Dim strArr
With Workbooks(wb).VBProject
ReDim strArr(0 To .VBComponents(strModulName).CodeModule.CountOfLines - 1)
For intZ = 1 To .VBComponents(strModulName).CodeModule.CountOfLines
strArr(intZ - 1) = .VBComponents(strModulName).CodeModule.Lines(intZ, 1)
Next
End With
With objTB
zei = .Range("A65536").End(xlUp).Row
If .Cells(1, 1) = "" Then zei = 0
.Cells(zei + 1, 1) = Sterne
.Cells(zei + 2, 1) = strModulName
For intZ = 1 To UBound(strArr) + 1
.Cells(zei + 2 + intZ, 1) = strArr(intZ - 1)
Next
.Columns.AutoFit
End With
End Sub

Anzeige
AW: vbacode ausdrucken
13.01.2006 14:30:49
Peter
Servus,
ich weiß nicht ob es eine einfachere Lösung gibt, die funktioniert auf jeden Fall.


      
Option Explicit
Public bolFound As Boolean
Sub ExCode(strModulName As String, objTB As Object)
Dim intZ As Integer
Dim strArr
bolFound = 
False
With ThisWorkbook.VBProject
    
For intZ = 1 To .VBComponents.Count
        
If strModulName = .VBComponents(intZ).Name Then bolFound = True
    
Next
    
If bolFound Then
        
ReDim strArr(0 To .VBComponents(strModulName).CodeModule.CountOfLines - 1)
        
For intZ = 1 To .VBComponents(strModulName).CodeModule.CountOfLines
            strArr(intZ - 1) = _
                .VBComponents(strModulName).CodeModule.Lines(intZ, 1)
        
Next
    
Else
        MsgBox "Es wurde kein Modul mit dem Namen (" & strModulName & ") gefunden" _
        , vbCritical, "Vorgang abgebrochen !"
    
End If
End With
With objTB
    
For intZ = 1 To UBound(strArr)
        .Cells(intZ, 1) = strArr(intZ - 1)
    
Next
    .Columns.AutoFit
End With
End Sub
Sub test()
Dim objWks As Object
Set objWks = Sheets("Tabelle1")
Call ExCode("Modul1", objWks)
If bolFound Then _
    Sheets("Tabelle1").PrintOut
Set objWks = Nothing
End Sub 


Wenn nicht stell halt wieder auf offen ;-)
MfG Peter
Anzeige
Danke an Euch beide :-) o.w.T.
13.01.2006 15:44:36
Reinhard
Gruß
Reinhard
ps:Das Forum lebt auch von Rückmeldungen.
AW: vbacode ausdrucken
13.01.2006 16:26:29
Reinhard
Hallo Peter,
ich habe jetzt deinen Code so umgebaut, dass er eine fremde Datei öffnet und deren Module auflisten soll.
Anhand von meiner MsgBox sehe ich dass er erst DieseArbeitsmappe, dann die 3 Tabellen und dann Userform1 erkennt, alle haben Code in sich.
Dann kommt leider deine MsgBox "Vorgang abgebrochen" weil er die das Modul Userform1 nicht findet, obwohl es doch vorher erkannt wurde in meiner Msgbox.
Wenn ich die Meldung wegklicke kommt Typen unverträglich in Zeile
For intZ = 1 To UBound(strArr)
da dort strArr leer ist.
Geschrieben wurde nur "Option Explicit" in A1 bis A9 mit je einer Leerzeile dazwischen. Welche Fehler machte ich im Code?
Ausser in Test() machte ich nur Änderungen unten im With objTB Zweig.
Gruß
Reinhard
Option Explicit
Public bolFound As Boolean
Sub test2()
Dim i As Integer, zei As Integer, wb As String
Dim objWks As Object
Set objWks = ThisWorkbook.Sheets("Tabelle1")
wb = "kilahukwiss.xls"
Workbooks.Open CurDir & "\" & wb
For i = 1 To Workbooks(wb).VBProject.VBComponents.Count
MsgBox Workbooks(wb).VBProject.VBComponents(i).Name
Call ExCode(Workbooks(wb).VBProject.VBComponents(i).Name, objWks)
Next i
'If bolFound Then Sheets("Tabelle1").PrintOut
End Sub
Sub ExCode(strModulName As String, objTB As Object)
Dim intZ As Long, zei As Long
Dim strArr
bolFound = False
With ThisWorkbook.VBProject
For intZ = 1 To .VBComponents.Count
If strModulName = .VBComponents(intZ).Name Then bolFound = True
Next
If bolFound Then
ReDim strArr(0 To .VBComponents(strModulName).CodeModule.CountOfLines - 1)
For intZ = 1 To .VBComponents(strModulName).CodeModule.CountOfLines
strArr(intZ - 1) = _
.VBComponents(strModulName).CodeModule.Lines(intZ, 1)
Next
Else
MsgBox "Es wurde kein Modul mit dem Namen (" & strModulName & ") gefunden" _
, vbCritical, "Vorgang abgebrochen !"
End If
End With
With objTB
zei = .Range("A65536").End(xlUp).Row + 1
For intZ = 1 To UBound(strArr)
zei = zei + intZ
.Cells(zei, 1) = strArr(intZ - 1)
Next
.Columns.AutoFit
End With
End Sub

Anzeige
AW: vbacode ausdrucken
13.01.2006 16:32:49
Reinhard
Hallo Peter,
ich glaube ich habe den Fehler, liegt wohl an Thisworkbook in deinem Code. Mal schauen.
Gruß
Reinhard

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige