如何删除VBA办公室字

Question

我怎么能在每一页的VBA字上删除只有空行前的空行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：我修改下面的代码删除空白页。如果一个空白页面包含任何或一些空白行（而不是其他文本），那么原始代码将删除所有这些，因为它们技术上是从页面顶部开始的。然后在第二次传递中，它只会将分页符看作页面上唯一的“段落”。如果找到，它将被删除。

我认为有以下可能解决在每个页面的顶部删除空白的问题。请记住，随着文本被删除，Word将继续“重绘”页面。但更重要的是，一个段落可以是任意大小，意味着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