@Oberschlumpf: Zeilen im VBA-Code und Modul ausles

Hi Thorsten,
du hattest vor knapp nem Monat mal was zum Thema Zeilen auslesen bei einem unbekannten Fehler geposten. Ich hatte ja ein bisschen was rumgemäckelt und dir versprochen meine Ideen einzubauen und mich zu melden.
Nun ja - hiermit will ich dies dann auch endlich mal tun.
Erstmal mein Kompliment für die Lösung - ist ne gute Möglichkeit gerade die Fehler zu behandeln, an die man nicht denkt, besonders wenn eine Anwendung von anderen Leuten genutzt wird.
Ich habe an deiner Prozedur "AddLn ()" ein bisschen was verändert.
- deine Eingangsprüfung habe ich bei mir auf den Start eines Moduls bezogen, nicht auf das Ende, aber das ist nur Ansichtssachen - wie man´s halt will
- dann habe ich Mid durch Left ersetzt - ebenfalls nur Kosmetik
- mir ist auch aufgefallen, warum du nicht InStr() verwendet hast - gibt Probleme das z.B. Sub auch in ".Subscript" bei Diagrammen vorkommt, deshalt also Mid (oder halt Left)
Nun aber zu den wesentlichen Anpassungen:
- wie letztens schon gesagt, habe ich noch "Option Explicit" mit aufgenommen
- dann gab´s bei mir immer Sorgen mit dem Zeilenumbruch, dann kam manchmal auch in die folgende Zeile die Zeilennummer, was dann die Anweisung unterbrochen hat - Ergebnis Fehler!
- Ähnliches Problem bei "Select Case", zwischen "Select Case" und dem ersten Case darf keine Zeilennummer stehen - keine Ahnung wieso, aber da kam bei mir immer ne Fehlermeldung.
Das war´s auch schon - du kannst also mit recht stolz auf dich sein ;o)
Ach ja - da hätte ich ja fast meine Geistigen Ergüsse vergessen:
'Nicht registrierte Benutzung der Excel Code Jeanie 1.0 Sub AddLN() If pstrDatName <> "" And pstrDatName = pstrNeuDatName Then Exit Sub Dim lstrZeile As String, liZeile As Integer, liSuche As Integer, lboLeer As Boolean Dim li_Zaehler As Integer If pstrDatName = "" Then pstrDatName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , pstrUeberschrift) End If If pstrDatName = "Falsch" Then Exit Sub liZeile = 1 lboLeer = True Open pstrDatName For Input As #1 Open pstrVerz & "AddDelLN.txt" For Output As #2 Do While Not EOF(1) Line Input #1, lstrZeile If (InStr(1, lstrZeile, "Sub ") <> 0 Or InStr(1, lstrZeile, "Function ") <> 0) _ And InStr(1, lstrZeile, "End") = 0 And InStr(1, lstrZeile, "Exit") = 0 Then 'Neue Prozedur/ Funktion startet liZeile = 1 End If If Left(lstrZeile, 15) <> "Option Explicit" And _ Left(lstrZeile, 6) <> "Public" And _ Left(lstrZeile, 3) <> "Dim" And _ Left(lstrZeile, 7) <> "Private" And _ Left(lstrZeile, 8) <> "Function" And _ Left(lstrZeile, 12) <> "End Function" And _ Left(lstrZeile, 3) <> "Sub" And _ Left(lstrZeile, 7) <> "End Sub" And _ Right(lstrZeile, 1) <> ":" Then 'Left(lstrZeile, 1) <> "'" And For liSuche = 1 To Len(lstrZeile) If Mid(lstrZeile, liSuche, 1) <> " " Then 'Zeile ist keine Leerzeile! lboLeer = False Exit For End If Next If lboLeer = True Then '=> Leerzeile, wird einfach nur übernommen! Print #2, lstrZeile Else If li_Zaehler = 0 Then 'Bisher kein Zeilenumbruch angefangen If InStr(1, lstrZeile, "'", vbTextCompare) <> 0 Then If Left(lstrZeile, 1) = "'" Then ' => ges. Zeile ist ein Kommentar Print #2, lstrZeile lboLeer = True Else For liSuche = 1 To InStr(1, lstrZeile, "'", vbTextCompare) - 1 If Mid(lstrZeile, liSuche, 1) <> " " Then ' Vor dem "'" stehen noch Zeiche => Zeilennummer kann gesetzt werden Print #2, liZeile & " " & lstrZeile liZeile = liZeile + 1 lboLeer = True Exit For End If Next If lboLeer = False Then 'vor dem "'" stehen keine Zeichen mehr (nur Leerzeichen) Print #2, lstrZeile lboLeer = True End If End If If Right(lstrZeile, 2) = " _" Then li_Zaehler = li_Zaehler + 1 Else 'Prüfung, auf Select Case - Anwendung, wenn ja - ebenfalls keine Ziffer in der nächsten Zeile If InStr(1, lstrZeile, "Select Case ") <> 0 Then For liSuche = InStr(1, lstrZeile, "Select Case ") - 1 To 1 Step -1 If Mid(lstrZeile, liSuche, 1) <> " " Then 'Es gibt noch Zeicher vor Select Case => Nummer kann gesetzt werden Exit For End If Next If liSuche > -1 Then li_Zaehler = li_Zaehler + 1 End If End If End If Else If Right(lstrZeile, 2) = " _" Then li_Zaehler = li_Zaehler + 1 Print #2, liZeile & " " & lstrZeile liZeile = liZeile + 1 lboLeer = True Else 'Prüfung, auf Select Case - Anwendung, wenn ja - ebenfalls keine Ziffer in der nächsten Zeile If InStr(1, lstrZeile, "Select Case ") <> 0 Then For liSuche = InStr(1, lstrZeile, "Select Case ") - 1 To 1 Step -1 If Mid(lstrZeile, liSuche, 1) <> " " Then 'Es gibt noch Zeicher vor Select Case => Nummer kann gesetzt werden Exit For End If Next If liSuche > -1 Then li_Zaehler = li_Zaehler + 1 End If End If Print #2, liZeile & " " & lstrZeile liZeile = liZeile + 1 lboLeer = True End If End If Else 'mindestens in der vorhergehenden Zeile ist ein Zeilenumbruch _ => keine Zeilennummer schreiben, da sonst Fehlermeldung If Right(lstrZeile, 2) = " _" Then li_Zaehler = li_Zaehler + 1 Print #2, lstrZeile lboLeer = True Else li_Zaehler = 0 Print #2, lstrZeile lboLeer = True End If End If End If Else 'Zeile enthält eines der Schlüsselwörter 'Zeile einfach nur kopieren, ohne Zeilennummer Print #2, lstrZeile End If Loop Close End Sub
Vielleicht findest du ja noch ein paar andere Änderungen, bis jetzt sind mir jedenfalls noch keine Fehler aufgefallen
Gruss
Chris
PS: Ach ja wie kann ich eigentlich auf den alten Thread verweisen?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub AddLN() If pstrDatName <> "" And pstrDatName = pstrNeuDatName Then Exit Sub Dim lstrZeile As String, liZeile As Integer, liSuche As Integer, lboLeer As Boolean Dim li_Zaehler As Integer If pstrDatName = "" Then pstrDatName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , pstrUeberschrift) End If If pstrDatName = "Falsch" Then Exit Sub liZeile = 1 lboLeer = True Open pstrDatName For Input As #1 Open pstrVerz & "AddDelLN.txt" For Output As #2 Do While Not EOF(1) Line Input #1, lstrZeile If (InStr(1, lstrZeile, " Sub ") 0 Or InStr(1, lstrZeile, " Function ") <> 0) _ And InStr(1, lstrZeile, "End") = 0 And InStr(1, lstrZeile, "Exit") = 0 Then 'Neue Prozedur/ Funktion startet liZeile = 1 End If If Left(lstrZeile, 15) <> "Option Explicit" And _ Left(lstrZeile, 6) <> "Public" And _ Left(lstrZeile, 3) <> "Dim" And _ Left(lstrZeile, 7) <> "Private" And _ Left(lstrZeile, 8) <> "Function" And _ Left(lstrZeile, 12) "End Function " And _ Left(lstrZeile, 3) "Sub" And _ Left(lstrZeile, 7) "End Sub " And _ Right(lstrZeile, 1) ":" Then 'Left(lstrZeile, 1) "'" And For liSuche = 1 To Len(lstrZeile) If Mid(lstrZeile, liSuche, 1) " " Then 'Zeile ist keine Leerzeile! lboLeer = False Exit For End If Next If lboLeer = True Then '=> Leerzeile, wird einfach nur übernommen! Print #2, lstrZeile Else If li_Zaehler = 0 Then 'Bisher kein Zeilenumbruch angefangen If InStr(1, lstrZeile, "'", vbTextCompare) 0 Then If Left(lstrZeile, 1) = "'" Then ' => ges. Zeile ist ein Kommentar Print #2, lstrZeile lboLeer = True Else For liSuche = 1 To InStr(1, lstrZeile, "'", vbTextCompare) - 1 If Mid(lstrZeile, liSuche, 1) " " Then ' Vor dem "'" stehen noch Zeiche => Zeilennummer kann gesetzt werden Print #2, liZeile & " " & lstrZeile liZeile = liZeile + 1 lboLeer = True Exit For End If Next If lboLeer = False Then 'vor dem "'" stehen keine Zeichen mehr (nur Leerzeichen) Print #2, lstrZeile lboLeer = True End If End If If Right(lstrZeile, 2) = " _" Then li_Zaehler = li_Zaehler + 1 Else 'Prüfung, auf Select Case - Anwendung, wenn ja - ebenfalls keine Ziffer in der nächsten Zeile If InStr(1, lstrZeile, "Select Case ") 0 Then For liSuche = InStr(1, lstrZeile, "Select Case ") - 1 To 1 Step -1 If Mid(lstrZeile, liSuche, 1) " " Then 'Es gibt noch Zeicher vor Select Case => Nummer kann gesetzt werden Exit For End If Next If liSuche > -1 Then li_Zaehler = li_Zaehler + 1 End If End If End If Else If Right(lstrZeile, 2) = " _" Then li_Zaehler = li_Zaehler + 1 Print #2, liZeile & " " & lstrZeile liZeile = liZeile + 1 lboLeer = True Else 'Prüfung, auf Select Case - Anwendung, wenn ja - ebenfalls keine Ziffer in der nächsten Zeile If InStr(1, lstrZeile, "Select Case ") 0 Then For liSuche = InStr(1, lstrZeile, "Select Case ") - 1 To 1 Step -1 If Mid(lstrZeile, liSuche, 1) " " Then 'Es gibt noch Zeicher vor Select Case => Nummer kann gesetzt werden Exit For End If Next If liSuche > -1 Then li_Zaehler = li_Zaehler + 1 End If End If Print #2, liZeile & " " & lstrZeile liZeile = liZeile + 1 lboLeer = True End If End If Else 'mindestens in der vorhergehenden Zeile ist ein Zeilenumbruch _ => keine Zeilennummer schreiben, da sonst Fehlermeldung If Right(lstrZeile, 2) = " _" Then li_Zaehler = li_Zaehler + 1 Print #2, lstrZeile lboLeer = True Else li_Zaehler = 0 Print #2, lstrZeile lboLeer = True End If End If End If Else 'Zeile enthält eines der Schlüsselwörter 'Zeile einfach nur kopieren, ohne Zeilennummer Print #2, lstrZeile End If Loop Close End Sub

Beliebteste Forumthreads (12 Monate)

@Oberschlumpf: Zeilen im VBA-Code und Modul ausles

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

286 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

@Oberschlumpf: Zeilen im VBA-Code und Modul ausles

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

286 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread