Office: Leere Zeilen löschen

Hallo zusammen,

ich arbeite gerade an einem VBA-Makro für Microsoft Word und komme einfach nicht weiter. Vielleicht kann mir hier jemand helfen?

Was ich erreichen möchte:
Ich möchte ein Makro schreiben, das jede Zeile in einem Word-Dokument durchsucht und löscht, wenn die Zeile leer ist. Das bedeutet: Leerzeilen sowie Zeilen, die ausschließlich aus Leerzeichen und/oder Tabulatoren bestehen, sollen entfernt werden.

Falls das zu aufwendig oder nicht praktikabel ist, wäre eine alternative Lösung ebenfalls hilfreich:
Alle Zeilen sollen gelöscht werden, die keine Buchstaben (A–Z, a–z) oder Ziffern (0–9) enthalten.

Wichtig ist dabei:
Im Dokument gibt es auch Absätze die mit Shift + Enter eingefügt wurden (manueller oder weicher Zeilenumbruch). Dabei gibt es Probleme.

Meine bisherigen Ansätze:

Code:

Sub LeereAbsaetzeLoeschen()
    Dim anzAbsaetze As Long
    Dim i As Long
    Dim absatzText As String
    
    With ActiveDocument
        anzAbsaetze = .Paragraphs.Count
        For i = anzAbsaetze To 1 Step -1
            absatzText = .Paragraphs(i).Range.text
            'Alle Steuerzeichen und Leerzeichen entfernen und prüfen
            If Len(Replace(Replace(Replace(absatzText, Chr(9), ""), _
                Chr(32), ""), Chr(13), "")) = 0 Then
                .Paragraphs(i).Range.Delete
            End If
        Next i
    End With
End Sub

Sub LeereAbsaetzeLoeschen1()
Dim anzAbsaetze As Long, i As Long

    With ActiveDocument
        anzAbsaetze = .Paragraphs.Count
            For i = anzAbsaetze To 1 Step -1
                If Left(.Paragraphs(i), 1) = Chr(13) Then
                    .Paragraphs(i).Range.Delete
                End If
            Next i
    End With

End Sub

Vielen Dank im Voraus für eure Unterstützung!

Alex

 

Ich finde Deinen Ansatz viel zu umständlich und würde vier Suchläufe hintereinander schalten. Hier die Codes, die ich so ähnlich auch in Tuhls' Tools verwende.
Gruß
Burkhard

Code:

Sub Leerzeilenraus()
'Entfernt Fuehrende Blanks
    Call ChangeChar("^13 {1;}", "^p", "", False, True)
    Selection.Expand Unit:=wdCharacter
    If Selection = Chr(32) Then Selection.Delete

' Entfernt sinnlose Tabsprünge 
    Call ChangeChar("^9{1;}^13", "^13", "", False, True)

'Entfernt Zeilenschaltungen vor Absatz
    Call ChangeChar("^l{2;}", "^l", "", False, True)

' Entfernt mehrfache Absatzmarken
     Call ChangeChar("^13{2;}", "^13", "", False, True)
     Call ChangeChar("^p ", "", "", False, False)
End Sub

Sub ChangeChar(SuchZeichen, ErsatzZeichen, StyleSuch, BooleFormat, BooleWildCard)
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = SuchZeichen
        If BooleFormat Then .Style = ActiveDocument.Styles(StyleSuch)
        .Font.Name = ""
        .Font.Hidden = False
        .Replacement.Text = ErsatzZeichen
        .Forward = True
        .Wrap = wdFindStop
        .Format = BooleFormat
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = BooleWildCard
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub