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"