VAB删除Word多余空行
2009-11-30 22:12
603 查看
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
本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/qffhq/archive/2008/10/08/3031282.aspx
空白页的检查,并可实现自动删除!
在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
本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/qffhq/archive/2008/10/08/3031282.aspx
相关文章推荐
- 文字复制到WORD,删除多余空格或空行
- 删除word中的多余空行
- 如何删除word中多余的空格和空行
- word中批量删除多余空行用C++实现
- 使用EditPlus 删除文本文件中多余的空行 和 EditPlus 选择列
- 去除word中多余的空格及空行
- 如何删除Word文档中的空行
- 删除word文档中表格后的空行
- office2010删除多余空行
- word 删除空行
- 正则表达式删除多余空行
- sublime插件:DeleteBlankLines;功能:删除多余空行
- 删除字符串中多余的空白字符和空行(C语言实现)
- 巧用工具删除文本文件中的多余空白空行
- word中删除空行
- 软硬回车和word中删除空行
- Visual Studio如何删除多余的空行
- Word删除空行
- Ctrl+Shift+F不能删除多余空行的处理
- VBA删除WORD中所有的空行