如何在VBA Office Word中删除顶部空白行

Question

我如何才能删除唯一的 vba Word 2016中每页顶部的空白行。

我试图做这样的事情

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

但是该代码的问题在于，它不仅在页面顶部，而且在页面的中心或底部删除所有空白行。

同样，如果您可以在宏中实现删除空白页（上没有单词），那将是很棒的。谢谢。

Answer 1

更新2：我想出了如何删除文档中的最后一个手册页面。

更新1：我修改了以下代码以删除空白页面。如果一个空白页由任何或多个空白行（而不是其他文本）组成，则原始代码将删除所有这些线条，因为它们从技术上始于页面的顶部。然后，在第二次通过中，它将仅将页面断开作为页面上唯一的"段落"。如果发现，它将被删除。

我认为以下内容可以解决每页顶部删除空白的问题。请记住，随着文本的删除，单词将继续"重新绘制"该页面。但更重要的是，段落可以是任何大小，这意味着1、2或20"线"。

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