Wie oben Leerzeilen in VBA Büro Wort

Question

entfernen Wie ich nur die Leerzeilen am oberen Rand jeder Seite in VBA Wort 2016.

löschen kann ich versuchte, so etwas wie dieses

Sub RemoveBlankParas() 
    Dim para As Paragraph 

    For Each para In ActiveDocument.Paragraphs 
     If Len(para.Range.Text) = 1 Then 
      'only the paragraph mark, so.. 
      para.Range.Delete 
     End If 
    Next para 
End Sub 

zu tun

Aber das Problem mit diesem Code ist, dass es alle leeren Zeilen nicht nur am Anfang der Seite entfernt, sondern auch in der Mitte oder unten auf der Seite.

Auch wenn Sie das Entfernen von leeren Seiten (Seiten mit keinen Worten darauf) im Makro implementieren können, wird das fantastisch. Vielen Dank.

Answer 1

UPDATE 2: Ich habe herausgefunden, wie man den letzten manuellen Seitenumbruch im Dokument löscht.

UPDATE 1: Ich habe den folgenden Code geändert, um leere Seiten zu löschen. Wenn eine leere Seite aus einer oder mehreren Leerzeilen (und nicht aus anderem Text) besteht, löscht der ursprüngliche Code alle, da sie technisch am Anfang einer Seite beginnen. Im zweiten Durchgang wird dann nur der Seitenumbruch als einziger Absatz auf der Seite angezeigt. Wenn es gefunden wird, wird es gelöscht.

Ich denke, das Folgende kann das Problem des Löschens der Leerzeichen am oberen Rand jeder Seite lösen. Beachten Sie, dass Word die Seite weiterhin neu zeichnet, wenn Text gelöscht wird. Vor allem aber kann ein Absatz eine beliebige Größe haben, also 1, 2 oder 20 Zeilen.

Option Explicit 

Sub RemoveBlankParas() 
    Dim oDoc  As Word.Document 
    Dim para  As Word.Paragraph 
    Dim i   As Integer 
    Dim oRng  As Range 
    Dim lParas  As Long 
    Dim lEnd  As Long 
    Dim lDeleted As Long 

    Set oDoc = ActiveDocument 
    lParas = oDoc.Paragraphs.Count   ' Total paragraph count 
    'Debug.Print "Total paragraph Count: " & lParas 

    ' Loop thru each page 
    i = 0  ' Reset starting page - if I'm testing 
    Do 
     ' Select one page 
     i = i + 1 
     Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i 
     Set oRng = Selection.Range 
     oRng.End = Selection.Bookmarks("\Page").Range.End 
     oRng.Select 

     Debug.Print "Range Count: " & oRng.Paragraphs.Count  ' Paragraphs in this page range 
     lEnd = lEnd + oRng.Paragraphs.Count       ' Keep track of how many processed 

     For Each para In oRng.Paragraphs 
      'Debug.Print "Par Len:" & vbTab & Len(para.Range.Text) & " | " & Left(para.Range.Text, Len(para.Range.Text) - 1) 
      If Len(para.Range.Text) = 1 Then 
       para.Range.Delete 
       lDeleted = lDeleted + 1 
      Else  ' If not blank, then delete o more in this page! 
       Exit For 
      End If 
     Next para 

     ' Calc how many paragraphs processed 
     If lDeleted + lEnd >= lParas Then  ' If more that we started with, let's call it a day! 
      Exit Do 
     End If 
    Loop 

    ' You can add code to loop thru each page and if only one paagraph, ... 
    ''' Check if 'empty' page 

    ' Get latest count... 
    lParas = oDoc.Paragraphs.Count   ' Total paragraph count 

    lDeleted = 0  ' reset stuff - in case 
    lEnd = 0 
    i = 0 
    Do 
     i = i + 1 
     Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i 
     Set oRng = Selection.Range 
     oRng.End = Selection.Bookmarks("\Page").Range.End 
     oRng.Select 

     Debug.Print "Range Count: " & oRng.Paragraphs.Count  ' Paragraphs in this page range 
     lEnd = lEnd + oRng.Paragraphs.Count 
     If oRng.Paragraphs.Count = 1 Then 
      If oRng.Paragraphs(1).Range.Text = Chr(12) & Chr(13) Then 
       oRng.Paragraphs(1).Range.Delete 
       lDeleted = lDeleted + 1 
       i = i - 1 
      'ElseIf Len(oRng.Paragraphs(1).Range.Text) = 1 Then 
      ' oRng.Paragraphs(1).Range.Delete 
      ' lDeleted = lDeleted + 1 
      ' i = i - 1 
      End If 
     End If 
     If lEnd >= lParas Then 
      Exit Do 
     End If 
    Loop 

    ' Finally!!! Deal with the lingering final page-break! 
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=999  ' Go to Last Page. 
    Set oRng = Selection.Range            ' Select the end.. 
    oRng.MoveStart wdCharacter, -3           ' Backup 3 characters 
    If Left(oRng.Text, 2) = Chr(13) & Chr(12) Then       ' Should be 13+12 
     oRng.Text = ""              ' Remove that thingy! 
    End If 

    Set para = Nothing 
    Set oDoc = Nothing 
    Exit Sub 
End Sub