关于word文档切割的问题

iszc

论坛中找到的一段经“怀英慕者”修改的代码，可以删除掉分割后的文档出现的末页空白页，但新建的文档改变了切割原文件的左右页边距（新建文件与原文件页边距不同）

怎样修改这段代码能做到不改变切割后的文件页边距又能删除掉分割后的文档出现的末页空白页

1.                          Selection.EndKey Unit:=wdStory
   
2.                          Selection.TypeBackspace
   
3.                          Selection.Delete Unit:=wdCharacter, Count:=1
   
4.                          '以上三行代码的作用是删除掉分割后的文档出现的末页空白页

复制代码

全部代码

1. Sub 每两页分割为一个新文档__保存到同目录下()
   
2. '2010.01.30 雨雪霏霏改编自守柔版主代码。
   
3. '守柔版主代码见：《请教：如何将一个word文档按页保存为多个word文档？
   
4. '链接为：http://club.excelhome.net/viewthread.php?tid=52690
   
5. 
   
6.         Dim MyPath As String, PageCount As Integer
   
7.         Dim StartRange As Long, EndRange As Long, MyRange As Range
   
8.         Dim Fn As String, MyDoc As Document, i As Integer
   
9. 
   
10. 
    
11.         On Error Resume Next
    
12.         Application.ScreenUpdating = False
    
13. 
    
14.         MyPath = ActiveDocument.Path    '取得文档路径
    
15.         PageCount = Selection.Information(wdNumberOfPagesInDocument)    '取得文档总页数
    
16. 
    
17. 
    
18.         Selection.HomeKey Unit:=wdStory    '将光标移至文档起点
    
19.         For i = 1 To PageCount / 2 + (PageCount Mod 2)    '设置循环次数
    
20.                 StartRange = Selection.Start    '取得该页的第一个字符位置
    
21.                 Selection.EndKey Unit:=wdLine    '将光标移动到该页首行的最后位置
    
22.                 Fn = i & ActiveDocument.Name    '-1的目的是防止该页首行含有段落标记,导致出错.
    
23.                 If i * 2 >= PageCount Then    '如果循环到达最后一页
    
24.                         EndRange = ActiveDocument.Content.End    '将文档最后位置赋值于EndRange
    
25.                 Else
    
26.            '否则,将下两页的起始位置赋值于EndRange(等同于下一页的最后位置)
    
27.                         Selection.GoToNext (wdGoToPage)
    
28.                         Selection.GoToNext (wdGoToPage)
    
29.                         EndRange = Selection.Start
    
30.                 End If
    
31.                 Set MyRange = ActiveDocument.Range(StartRange, EndRange)  '将两页中的内容进行复制
    
32.                 MyRange.Copy
    
33. 
    
34. 
    
35.                 Set MyDoc = Documents.Add    '新建一空白文档
    
36.                 With MyDoc
    
37.                          .Content.Paste    '在新文档中粘贴
    
38.                          .Content.Paragraphs.Last.Range.Delete '删除新文档末尾多出来的一个段落标记
    
39.                        
    
40.                          Selection.EndKey Unit:=wdStory
    
41.                          Selection.TypeBackspace
    
42.                          Selection.Delete Unit:=wdCharacter, Count:=1
    
43.                          '以上三行代码的作用是删除掉分割后的文档出现的末页空白页
    
44. 
    
45.                          .SaveAs FileName:=MyPath & "/" & Fn
    
46.                          '保存新文档到原文档所在目录。如果删除“MyPath & "/" & ”，。则保存到“我的文档”中。
    
47.                          .Close    '关闭新文档
    
48.                 End With
    
49.         Next
    
50. 
    
51. 
    
52.         Application.ScreenUpdating = True
    
53. End Sub

复制代码