Lösung: Zeilen im VBA-Code und Modul auslesen
21.03.2005 11:46:31
Oberschlumpf
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 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
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:
Die Datei https://www.herber.de/bbs/user/19924.jpg wurde aus Datenschutzgründen gelöscht
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:
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
Die UF sollte so aussehen:
Die Datei https://www.herber.de/bbs/user/19932.jpg wurde aus Datenschutzgründen gelöscht
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:
Die Datei https://www.herber.de/bbs/user/19936.jpg wurde aus Datenschutzgründen gelöscht
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
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