Lösung: Zeilen im VBA-Code und Modul auslesen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Lösung: Zeilen im VBA-Code und Modul auslesen
von: Oberschlumpf
Geschrieben am: 21.03.2005 11:46:31


Userbild

Hallo Excelfreunde
Vor ca. einem Jahr fragte ich, ob das Auslesen der Zeilennummer im VBA-Code und die Angabe des entsprechenden Moduls irgendwie möglich ist, um die Fehlerbereinigung gerade in größeren Projekten zu vereinfachen.
Wer das noch mal nachlesen möchte, schaut sich diesen Thread an:
https://www.herber.de/index.html?https://www.herber.de/forum/archiv/432to436/t433060.htm
Und nun kann ich die oben gestellte Frage mit einem JA beantworten! :-)
Wenn der gesamte VBA-Code mit Zeilennummern versehen wird, kann man mit Hilfe der ON Error-Funktion und der undokumentierten Erl-Funktion (vielen Dank an Well Ness für diesen Hinweis) das Problem lösen.
Hier ein Beispiel:
Code im Work_Open Modul:


Private Sub Workbook_Open()
1     On Error GoTo Fehler
    Dim lstrMsg As String
      
2         If Range("C4").Value / Range("A4").Value <> Range("B4").Value Then
3             Application.EnableEvents = False
4             Range("A4").Value = "FALSCH"
5             Application.EnableEvents = True
6         End If
        
7     Exit Sub
    
Fehler:
    
8     pstrErr = "Tabellenblatt: " & ActiveSheet.Name & vbCrLf & _
              "Modul: ''Workbook_Open''" & vbCrLf & "Fehlermeldung: " & _
               Err.Description & vbCrLf & "Zeilennummer: " & Erl
    
9     lstrMsg = MsgBox(pstrErr, vbCritical, "unerwarteter Fehler in...")
End Sub


     Code eingefügt mit Syntaxhighlighter 2.5

Code im allgemeinen Modul:


Public pstrErr As String
Sub Flaeche()
1     On Error GoTo Fehler
      Dim lstrMsg As String
      
2         If Range("C4").Value / Range("A4").Value <> Range("B4").Value Then
3             Application.EnableEvents = False
4             Range("A4").Value = "FALSCH"
5             Application.EnableEvents = True
6         End If
        
7     Exit Sub
    
Fehler:
    
8     pstrErr = "Tabellenblatt: " & ActiveSheet.Name & vbCrLf & _
                "Modul: ''Sub Flaeche''" & vbCrLf & "Fehlermeldung: " & _
                 Err.Description & vbCrLf & "Zeilennummer: " & Erl
                 
9     lstrMsg = MsgBox(pstrErr, vbCritical, "unerwarteter Fehler in...")
    
End Sub


     Code eingefügt mit Syntaxhighlighter 2.5

Wenn so wie folgt die Datei geöffnet wird:
(nach jeder Eingabe in A4 wird diese Bedingung geprüft: C4/A4=B4 )
Download des Tabellenkonverters                 Formeln in den Zellen als QuickNotiz
Von Oberschlumpf
A B C
1 Flächenberechnung:    
2      
3 Länge: Breite: Fläche:
4 ??? 10 cm 140 cm2

Da aber in A4 ein Text steht "???", kann durch diesen Wert nicht dividiert werden, und es erscheint diese Meldung:

Wenn man jetzt in Tabelle1 in Workbook_Open die Zeile 2 prüft:

2         If Range("C4").Value / Range("A4").Value <> Range("B4").Value Then

hat man den Fehler sofort gefunden :-)
Wenn man jetzt in der geöffneten Tabelle in A4 den Wert 0 eingibt, erscheint diese Meldung:
Userbild

Da auch nicht durch 0 dividiert werden kann, wird man auch hier zur Fehlerquelle "geführt" :-)
Zeilennummern hinzufügen oder entfernen
Damit man den Quellcode nicht per Hand mit Zeilennummern versehen muss, habe ich ein entsprechendes Programm geschrieben.
Es besteht aus einem allgemeinen Modul, einer Userform (UF) und ein wenig VBA-Code im Workbook_Open Modul, um die UF anzuzeigen.


Private Sub Workbook_Open()
    UserForm1.Show
    
End Sub


     Code eingefügt mit Syntaxhighlighter 2.5

Die UF sollte so aussehen:

Die Namen der einzelnen Objekte:
oberer Optionbutton: optAddLN
unterer Optionbutton: optDelLN
Commandbutton: cmdOK
Bevor man dieses Programm einsetzen kann, muss man zuerst den Quellcode, der mit Zeilennummern "bestückt" werden soll oder aus dem dieselben entfernt werden sollen, in eine beliebige Textdatei in einem beliebigen Verzeichnis speichern.
Nach Auswahl einer der beiden Möglichkeiten und Klick auf OK öffnet sich der Dateiauswahl-Dialog und man wählt die zuvor gespeicherte Textdatei aus.
Nun wird die Datei bearbeitet und wenn fertig, wurden Zeilennummern hinzugefügt oder entfernt und es erscheint diese Meldung:

So kann man direkt den aktualisierten Code in sein Projekt wieder einfügen, ohne das man denselben erst noch per STRG-C per Hand kopieren muss :-)
Es besteht ein kleiner Nachteil bei Verwendung dieses Programms :-)
Sogenannter "Spaghetti-Code" wird nur eingeschränkt unterstützt.
Wenn nicht vermeidbar, sollten nur Sprungmarken aus alphanumerischen Werten verwendet werden.
Bsp.
vorher
Goto Sprungmarke1
Sprungmarke1:
weiterer Code
nach Einsatz meines Programms
1 Goto Sprungmarke1
Sprungmarke1:
2 weiterer Code
vorher
GoTo 100
100 weiterer Code
nach Einsatz meines Programms
1 GoTo 100
2 100 weiterer Code
Wie zu erkennen, gibt es nun die Sprungmarke 100 nicht mehr oder an einer ganz anderen Stelle im Code und Fehler sind nun die Folge.
So, ich hoffe, ich habe nichts vergessen.
Hier nun der VBA-Code meines Programms:


Public pstrDatName As String, pstrNeuDatName As String, pstrVerz As String
Public pstrUeberschrift As String
Sub AddLN()
1         If pstrDatName = pstrNeuDatName Then Exit Sub
    Dim lstrZeile As String, liZeile As Integer, liSuche As Integer, lboLeer As Boolean
    Dim li_Zaehler As Integer
2         If pstrDatName = "" Then
3             pstrDatName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , pstrUeberschrift)
4         End If
    
5         If pstrDatName = "Falsch" Then Exit Sub
        
6     liZeile = 1
7     lboLeer = True
    
8     Open pstrDatName For Input As #1
9     Open pstrVerz & "AddDelLN.txt" For Output As #2
10         Do While Not EOF(1)
11             Line Input #1, lstrZeile
                
'                If InStr(1, lstrZeile, "End Sub") <> 0 Or InStr(1, lstrZeile, "End Function") Then
12                 If Mid(lstrZeile, 1, 7) = "End Sub" Or Mid(lstrZeile, 1, 12) = "End Function" Then
13                     liZeile = 1
14                 End If
                
15                 If Mid(lstrZeile, 1, 3) <> "Sub" And _
                   Mid(lstrZeile, 1, 7) <> "Private" And _
                   Mid(lstrZeile, 1, 7) <> "End Sub" And _
                   Mid(lstrZeile, 1, 8) <> "Function" And _
                   Mid(lstrZeile, 1, 12) <> "End Function" And _
                   Mid(lstrZeile, 1, 6) <> "Public" And _
                   InStr(1, lstrZeile, "Dim") = 0 And _
                   Mid(lstrZeile, 1, 1) <> "'" And _
                   Right(lstrZeile, 1) <> ":" Then
16                             For liSuche = 1 To Len(lstrZeile)
17                                 If Mid(lstrZeile, liSuche, 1) <> " " Then
18                                     lboLeer = False
19                                     Exit For
20                                 End If
21                             Next
                            
22                             If Right(lstrZeile, 1) = "_" Then
23                                 li_Zaehler = li_Zaehler + 1
24                             End If
                            
25                             If li_Zaehler <= 1 Then
26                                     If lboLeer = False Then
27                                             Print #2, liZeile & " " & lstrZeile
28                                             liZeile = liZeile + 1
29                                             lboLeer = True
30                                         Else
31                                             Print #2, lstrZeile
32                                     End If
33                                 Else
34                                     If Right(lstrZeile, 1) = "_" Then
35                                             Print #2, lstrZeile
36                                             lboLeer = True
37                                         Else
38                                             li_Zaehler = 0
39                                             Print #2, lstrZeile
40                                             lboLeer = True
41                                     End If
42                             End If
43                         Else
44                             If InStr(1, lstrZeile, "Exit") > 0 Or InStr(1, lstrZeile, "ReDim") > 0 Then
45                                     Print #2, liZeile & " " & lstrZeile
46                                     liZeile = liZeile + 1
47                                 Else
48                                     Print #2, lstrZeile
49                             End If
50                 End If
51         Loop
52     Close
End Sub
Sub DelLN()
    Dim lstrZeile As String, liSuche As Integer, liSpalte As Integer
1     pstrDatName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , pstrUeberschrift)
    
2         If pstrDatName = "Falsch" Then Exit Sub
        
3         For liSuche = 1 To Len(pstrDatName)
4             If Mid(pstrDatName, liSuche, 1) = "\" Then
5                 liSpalte = liSuche
6             End If
7         Next
        
8     pstrVerz = Left(pstrDatName, liSpalte)
9     pstrNeuDatName = Right(pstrDatName, Len(pstrDatName) - liSpalte)
10     Open pstrDatName For Input As #1
11     Open pstrVerz & "AddDelLN.txt" For Output As #2
    
12     liSpalte = 0
    
13         Do While Not EOF(1)
14             Line Input #1, lstrZeile
15                 For liSuche = 1 To Len(lstrZeile)
16                     If IsNumeric(Mid(lstrZeile, liSuche, 1)) = True Then
17                             liSpalte = liSpalte + 1
18                         Else
19                             Exit For
20                     End If
21                 Next
                
22                 If liSpalte > 0 Then
23                         Print #2, Right(lstrZeile, Len(lstrZeile) - (liSpalte + 1))
24                         liSpalte = 0
25                     Else
26                         Print #2, lstrZeile
27                 End If
28         Loop
29     Close
    
End Sub
Sub FileOpen()
    Dim liFileOpen As Integer
    
1     liFileOpen = Shell("notepad " & pstrVerz & "AddDelLN.txt", vbNormalFocus)
2     AppActivate liFileOpen
3     SendKeys "+(^{End})", True
4     SendKeys "^(C)"
5     SendKeys "%{F4}"
6     MsgBox "Je nach Auswahl wurden dem von Ihnen gewählten Quellcode " & _
            "Zeilennummern hinzugefügt oder entfernt." & vbCrLf & vbCrLf & _
            "Der modifizierte Quellcode wurde automatisch in die Zwischenablage " & _
            "eingefügt" & vbCrLf & "und kann von Ihnen nun verwendet werden."
7     Kill pstrDatName
8     Name pstrVerz & "AddDelLN.txt" As pstrVerz & pstrNeuDatName
    
End Sub


     Code eingefügt mit Syntaxhighlighter 2.5

Das war's :-)
Ich hoffe, dass das hier beschriebene Problem nicht schon für jeden ein alter Hut ist und ich vielleicht dem Einen oder Anderen helfen konnte.
Über Euer Feedback würde ich mich sehr freuen.
Ciao
Thorsten
Bild

Betrifft: AW: Lösung: Zeilen im VBA-Code und Modul auslesen
von: ChrisSp
Geschrieben am: 21.03.2005 12:43:22
Hi Thorsten,
genau vor dem gleichen Problem steh ich auch. Falls bei den verteilten Makros irgendein unerwartetes Problem auftritt, geht immer das große Raten los ;o)
Ich habe mich gleich mal rangesetzt und deine Lösung ausprobiert, wenn ich alles richtig interpretiere soll nach dem Aktivieren einer der Optionbuttons das jeweilige Makro gestartet werden, oder kommt da noch irgendwas anderes rein?
Meine Version:

Private Sub cmdOK_Click()
If UserForm1.optAddLN.Value = True Then
    Unload Me
    AddLN
ElseIf UserForm1.optDelLN.Value = True Then
    Unload Me
    DelLN
Else
    Unload Me
End If
End Sub

Nach dem Start ergibt sich dann folgendes Problem, das Makro springt gleich in der Zeile 1 des Makros "AddLN" aus, da bei mir "pstrDatName = pstrNeuDatName" gleich "" ist, da sie ja noch nicht erfasst wurden ???
Ich denke mal da habe ich irgendwas falsch gemacht - Hast du ne Vorschlag?
Gruss
Chris
Bild

Betrifft: AW: Lösung: Zeilen im VBA-Code und Modul auslesen
von: Oberschlumpf
Geschrieben am: 21.03.2005 12:55:32
upppppssssss
Hallo Chris
Sorry, Du hast Recht! Da hab ich einiges an Code vergessen, hier zu veröffentlichen.
In der Userform muss noch dieser Code eingefügt werden:


Private Sub cmdOK_Click()
1     If optAddLN.Value = True Then
2             DelLN
3             Kill pstrDatName
4             FileCopy pstrVerz & "AddDelLN.txt", pstrDatName
5             AddLN
6             FileOpen
7         Else
8             DelLN
9             FileOpen
10     End If
    
End Sub
Private Sub optAddLN_Click()
1     pstrUeberschrift = "Zeilennummern hinzufügen"
2     cmdOK.Enabled = True
    
End Sub
Private Sub optDelLN_Click()
1     pstrUeberschrift = "Zeilennummern entfernen"
2     cmdOK.Enabled = True
End Sub


     Code eingefügt mit Syntaxhighlighter 2.5

Tut mir echt leid für alle, die ihr Glück bisher vergeblich versucht haben.
Funktioniert es denn nun, was es eigentlich auch sollte?
Ciao
Thorsten
Bild

Betrifft: Super Arbeit, mit ganz kleinem aber
von: ChrisSp
Geschrieben am: 21.03.2005 13:20:05
Hi Thorsten,
ich habe deinen Code nun ein einem Makro mal ausprobiert und ich muss sagen ECHT KLASSE, aber 2 Kleinigkeiten sind mir aufgefallen, ich habe mir angewöhnt vor den Code ein *Option Explicit* zu packen, was bei den Ausnahmen (Sub, End Sub etc.) noch nicht dabei war.
Außerdem ist es ein paar mal aufgetreten, das trotz eines Zeilenumbruches das "_" am Ende überlesen wurden und die nächste Zeile auch nummeriert wurde???? Wieso genau konnte ich deinem Code noch nicht entlocken, aber mal schau´n. Dieser Fehler ist aber nur 3 mal aufgetreten auf ca. 2000 Zeilen mit ein paar mehr Zeilenumbrüchen, was die Sache noch ein wenig rätselhafter macht!
sonst ist das Ding echt cool!!!! damit kann man endlich eine etwas bessere Fehlerbehandlung durchführen! Ich werde mich gleich mal ransetzen und ein paar richtige Test zu absolvieren.
Gruss und besten Dank für das Tool
Chris
Bild

Betrifft: AW: Super Arbeit, mit ganz kleinem aber
von: Oberschlumpf
Geschrieben am: 21.03.2005 13:30:30
Hi Chris
Thx für Dein Feedback.
War mir fast klar, dass ich etwas vergessen hab (Option Explizit) :-)
Aber ich bin fast sicher, dass es noch mehr Befehle gibt, die eine Zeilennummerierung nicht "mögen" :-) Ich kenne nur leider nicht alle Befehle.
Aber....
Zusammen schaffen wir das schon...zusammen sind wir Excel-(Be)sieger :-))
Warum leider nicht jedes "_" am Ende einer Zeile erkannt wird, ist mir leider auch (noch) nicht klar.
Ich würde mich freuen, wenn Du nach Deinen Tests eine verbesserte Version auf dem Server speicherst.
Andere Interessenten sind natürlich auch weiterhin dazu "aufgefordert", ihre Verbesserungsvorschläge hier beizutragen.
Ciao
Thorsten
Bild

Betrifft: Eine kurze Frage noch...
von: ChrisSp
Geschrieben am: 21.03.2005 13:39:01
Hi Thorsten,
ich schau mal was bei den nächsten Test´s so rauskommt und poste dann wieder,ich hätte aber noch eine kurze Frage zu der Ermittlung der Ausnahmen. Wieso hast du auf InStr() verzichtet, dann könntest du doch auch die Sachen erkennen, die evtl. eingerückt sind - auch wenn ich nicht weiß, ob das jemand macht?! Oder hatte das einen ganz bestimmten Grund?
Gruss
Chris
Bild

Betrifft: AW: Eine kurze Frage noch...
von: Oberschlumpf
Geschrieben am: 21.03.2005 13:51:21
Hallo Chris
Ich hatte bzgl Sub,Function, End Sub, etc ursprünglich mit Instr() angefangen.
Aber irgendwas hakte. Ich weiß jetzt nur leider nicht mehr, was das war :-)
Im Moment sehe ich nämlich auch kein Problem mehr darin, z Bsp Instr(1,var,"Sub") zu verwenden. So könnte man sich auch die Zeilen mit "End Sub" sparen...oder analog dazu mit "End Function".
Wenn Du magst, kannst Du ja auch dieses mal testen.
Ciao
Thorsten
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Lösung: Zeilen im VBA-Code und Modul auslesen"