利用VBA删除Word文档中所有空白页面

Word文档中有很多字符，例如段落标记、手动换行符、制表符、分页符等，都是不可打印在纸张上的字符，如果一个页面中只包含无法打印在纸张上的的字符，我们就将其称为空白页面。在打印word文当前，应当将空白页面删除。如果文档中包含的空白页面太多，手工删除就比较麻烦，我们可以借助VBA来一键删除。

网上有人提供了一种代码：先求出一页的行数，将光标跳转到某页第一行后，再使用Selection对象的MoveDown方法，将Extend参数设定为wdExtend，向下移动当页的行数来选择当页全部内容。这个思路似乎是不错的，但是如果页面中含有表格，甚至表格中存在合并单元格，特别是表格中还存在跨页的单元格的话，那么Selection.Information(wdFirstCharacterLineNumber) 方法取得的数值实际上是错误的，也就是说在页面包含表格的情况下，可能无法准确获取这一页的行数。可以参看如下截图：

所以，上述思路实际上不够通用。更通用的思路是遍历文档中的所有页面，依次选择各页的全部内容，然后将不可打印字符全部替换为空字符，如果替换完成后的字符串长度不大于1，那么就可以判定这一页为空白页，将其删除即可。

与Character（字符）、Line（行）、Paragraph（段落）等文档结构单元对象不同的是，Page（页面）对象不能通过For Each-In的方式进行遍历。上面的思路最大的难点就是如何遍历文档所有页面。微软的官方文档提供的可用For Each-In方式遍历的Pages集合是“ActiveDocument.ActiveWindow.Panes(1).Pages”，这个集合显然不符合我们的要求。好在Selection对象的GoTo系方法中，将Which参数设定为wdGoToAbsolute的话，我们就可以按绝对位置将光标移动到每一个页面。由此我们得到如下代码：

Sub 删除文档中所有空白页面()
    Dim pages, page As Integer, oRng As Range, content$
    
    With Selection
        .StartOf wdStory
        pages = .Information(wdNumberOfPagesInDocument)
        For page = 1 To pages
            ' 依次跳转到文档的每一页
            Set oRng = .GoTo(wdGoToPage, Which:=wdGoToAbsolute, count:=page)
            ' 将整页内容设置为Range
            oRng.SetRange oRng.Start, oRng.Bookmarks("\page").End
            content = oRng.Text
            For i = 9 To 32
                content = Replace(Trim(content), Chr(i), "") '删除不可打印字符
            Next
            If Len(content) <= 1 Then oRng.Delete '删除空白页面
        Next
    End With
End Sub

有两个问题需要注意：

1、表格中如果存在跨页单元格，尽管不会影响删除空白页面，但是会影响oRng.Start和oRng.Bookmarks("\page").End的值，如果在“oRng.SetRange oRng.Start, oRng.Bookmarks("\page").End”这行代码下添加“”添加“oRng.Select”，就可以看到碰到跨页单元格时，选择区可能出现从上一页的中间开始到下一页的中间结束的情况。因此，编辑文档中的表格时，应当通过将表格行的段落格式中的换行与分页设置为“与下段同页”，或者将跨页单元格拆分成多行后将分布在上下两页中的各行分别合并成两个单元格，以此避免出现跨页单元格。

2、如果文档中的某个空白页里有分节符，并且该分节符前后页面设置不同（例如一部分为横向一部分为竖向），那么可能导致空白页面删除失败。这种情况下应该通过设置连续型分节符来分节。

下面再给出一段获取文档中每一页行数的代码，但是这段代码在文档中存在表格及分页符等特殊字符时，结果也会不够精确：

Sub 返回文档中每一页的行数()
    Dim iPage, pages, lines, pos As Integer
        With Selection
  
            .StartOf wdStory

            pages = .Information(wdNumberOfPagesInDocument)
            lines = 0
            iPage = 1
            Do        
                .MoveDown 'MoveDown方法比GoTo系方法获得的结果更准确，原因未知
                lines = lines + 1
                If iPage < .Information(wdActiveEndPageNumber) Then
                    Debug.Print iPage & ":" & lines '打印页码及该页的行数        
                    lines = 0
                    iPage = .Information(wdActiveEndPageNumber)
                End If
                If iPage = pages Then ' 处理最后一页
                    pos = .Start        
                    .MoveDown
                    lines = lines + 1
                    If pos = .Start Then ' 已移动到最后一行
                       Debug.Print iPage & ":" & lines
                       Exit Do
                    End If        
                End If        
            Loop 
  End With
End Sub