如何批量删除多个word文档尾页中多余的页（待分页符空白页）

Meゑゑ

如何批量删除多个word文档（同一文件夹内）尾页中多余页（待分页符空白页）。 每个word文档的第二页结尾都一个分页符（空白页），也就是尾页的分页符如何批量删除掉。 附件已上传，感谢大神帮助。不想使用什么慧办公和方方格子等。

祝洪忠-

如果是通过邮件合并生成的文档，可以将模板文档最后的分节符删除，然后适当调整表格高度。




显示分节符的方法是依次单击【文件】【选项】，打开Word选项对话框，在【显示】选项卡下，选中所有格式标记前的勾选。

ex_jiaopian

一般我是这样操作的，先把最后那一行的字号设为“1”，再把行距设为“固定值，1磅”，基本上表格没有抵满页面的话就缩上去了。

ming0018

最后一个回车符不能删除，只能缩小行间距。

zldccmx

以下代码，建议放在标准模块中运行

1. Dim ArryFile(), nFile '全局变量
   
2. Function SearchFile(ByVal Fd)
   
3. On Error Resume Next
   
4.     Dim Fl
   
5.     Dim SubFd
   
6.     Dim i As Integer
   
7.     i = Fd.Files.Count
   
8.     If i > 0 Then
   
9.         '--------------------------------------------------
   
10.         Set RegX = CreateObject("VBSCRIPT.REGEXP")    'RegEx为建立正则表达式
    
11.         With RegX
    
12.             .Global = True    '设置全局可用
    
13.             .Pattern = "(doc|docx|doxm)$"  '输入后缀名用|隔开"(xls|xlsx|docx|doc)$ ，只返回括号中对应文件类型的文件列表
    
14.         End With
    
15.         '--------------------------------------------------
    
16.         ReDim Preserve ArryFile(1 To nFile + i)
    
17.         For Each Fl In Fd.Files
    
18.             If RegX.test(Fl.Name) = True Then
    
19.                 nFile = nFile + 1
    
20.                 ArryFile(nFile) = Fl.Path
    
21.             End If
    
22.         Next
    
23.     End If
    
24.     If Fd.SubFolders.Count = 0 Then Exit Function
    
25.     For Each SubFd In Fd.SubFolders '遍历子目录
    
26.         SearchFile SubFd
    
27.     Next
    
28. End Function
    
29. Sub 批量删除当前目录下WORD文档最后一页空白行()
    
30.     Dim Doc As Document
    
31.     Dim Fso
    
32.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
33.     nFile = 0
    
34.     Set Fso = CreateObject("Scripting.FileSystemObject")
    
35.     DoEvents
    
36.     SearchFile Fso.GetFolder(ThisDocument.Path & "")
    
37.     For Each E In ArryFile
    
38.         Set Doc = Documents.Open(E)
    
39.         With ActiveWindow.Selection
    
40.             .GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=Doc.ComputeStatistics(wdStatisticPages) '强行跳转到最后一页
    
41.             .EndKey Unit:=wdStory, Extend:=wdExtend
    
42.             If .Paragraphs.Count = 1 Then '针对只有一行的情况
    
43.                 .Font.Size = 1
    
44.                 With Selection.ParagraphFormat
    
45.                     .LeftIndent = CentimetersToPoints(0)
    
46.                     .RightIndent = CentimetersToPoints(0)
    
47.                     .LineSpacingRule = wdLineSpaceExactly
    
48.                     .LineSpacing = 1
    
49.                 End With
    
50.             End If
    
51.         End With
    
52.         Doc.Close True
    
53.     Next
    
54. End Sub

复制代码