word中的空白頁,可能由於回車產生,還有可能由插入的分頁符產生,以下代碼通過讀取每一頁的數據並判斷,實現對Word中
空白頁的檢查,並可實現自動刪除!
在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 = 1 To PageCount
'超過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