word删除空白页案例
Option Explicit '删除全是图片,没有文字的页
Sub GetBlankPage()
Dim IsDelete As Boolean
Dim PageCount As Long
Dim rRange As Range
Dim iInt As Integer, DelCount As Integer
Dim tmpstr As String
IsDelete = True
PageCount = ThisDocument.BuiltInDocumentProperties(wdPropertyPages)
For iInt = PageCount To 1 Step -1
'超过PageCount退出
If iInt > PageCount Then Exit For
'取每一页的内容
If iInt = PageCount Then
Set rRange = ThisDocument.Range( _
Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start)
Else
Set rRange = ThisDocument.Range( _
Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start, _
End:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt + 1).Start _
)
End If
If Replace(rRange.Text, Chr(13), "") = "" Or Replace(rRange.Text, Chr(13), "") = Chr(12) Then
tmpstr = tmpstr & "第 " & iInt & " 页是空页" & vbCrLf
'删除?
If IsDelete Then
DelCount = DelCount + 1
'删除空白页
rRange.Text = Replace(rRange.Text, Chr(13), "")
rRange.Text = ""
'重算页数
PageCount = ThisDocument.BuiltInDocumentProperties(wdPropertyPages)
If iInt <> PageCount Then
'页删除后,页码变化,重新检查当前页
iInt = iInt - 1
Else
'最后一个空页
Set rRange = ThisDocument.Range( _
Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, PageCount - 1).Start, _
End:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, PageCount + 1).Start _
)
'如果是分页符,删除上一页中的换页符
If InStr(1, rRange.Text, Chr(12)) > 0 Then
rRange.Characters(InStr(1, rRange.Text, Chr(12))) = ""
Else
'没有分页符,通过选中后删除,最好不这样做,如果判断错误,有误删除的风险
Set rRange = ThisDocument.Range( _
Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start)
rRange.Select
Selection.Delete
End If
Exit For
End If
End If
End If
Next
If 1 = 1 Or Not IsDelete Then
If tmpstr = "" Then
MsgBox "没有空页", vbInformation + vbOKOnly
Else
MsgBox tmpstr, vbInformation + vbOKOnly
End If
Else
If DelCount > 0 Then MsgBox "删除空页 " & DelCount, vbInformation + vbOKOnly
End If
End Sub