Word软件中编程问题
SubSaveAsPage()DimPageCountAsInteger,StartRangeAsLong,EndRangeAsLong,MyRangeAsRange,F...
Sub SaveAsPage()
Dim PageCount As Integer, StartRange AsLong, EndRange As Long, MyRange As Range, Fn As String, MyDoc As Document
On Error Resume Next
PageCount =Selection.Information(wdNumberOfPagesInDocument)
Range(0, 0).Select '将光标移至文档起点
For i = 1 To PageCount '设置循环次数
StartRange = Selection.Start '取得该页的第一个字符位置
Selection.EndKey Unit:=wdLine '将光标移动到该页首行的最后位置
Fn = Range(StartRange, Selection.End - 1) '-1的目的是防止该页首行含有段落标记,导致出错.
If i = PageCount Then '如果循环到达最后一页
EndRange = ActiveDocument.Content.End '将文档最后位置赋值于EndRange
Else
Selection.GoToNext (wdGoToPage) '否则,将下一页的起始位置赋值于EndRange(等同于本页的最后位置)
EndRange = Selection.Start
End If
Set MyRange = Range(StartRange, EndRange) '将本页中的内容进行复制
MyRange.Copy
Set MyDoc = Documents.Add '新建一空白文档
MyDoc.Range(0, 0).Paste '在文档开始处粘贴
MyDoc.SaveAs FileName:=SaveFileName & i & ".doc" '保存文档名
MyDoc.Close '关闭文档
Next
End Sub
这个是将一个Word文档分成一页一页的,并分别保存。怎么改可以分成没十页十页,并分别保存呢? 展开
Dim PageCount As Integer, StartRange AsLong, EndRange As Long, MyRange As Range, Fn As String, MyDoc As Document
On Error Resume Next
PageCount =Selection.Information(wdNumberOfPagesInDocument)
Range(0, 0).Select '将光标移至文档起点
For i = 1 To PageCount '设置循环次数
StartRange = Selection.Start '取得该页的第一个字符位置
Selection.EndKey Unit:=wdLine '将光标移动到该页首行的最后位置
Fn = Range(StartRange, Selection.End - 1) '-1的目的是防止该页首行含有段落标记,导致出错.
If i = PageCount Then '如果循环到达最后一页
EndRange = ActiveDocument.Content.End '将文档最后位置赋值于EndRange
Else
Selection.GoToNext (wdGoToPage) '否则,将下一页的起始位置赋值于EndRange(等同于本页的最后位置)
EndRange = Selection.Start
End If
Set MyRange = Range(StartRange, EndRange) '将本页中的内容进行复制
MyRange.Copy
Set MyDoc = Documents.Add '新建一空白文档
MyDoc.Range(0, 0).Paste '在文档开始处粘贴
MyDoc.SaveAs FileName:=SaveFileName & i & ".doc" '保存文档名
MyDoc.Close '关闭文档
Next
End Sub
这个是将一个Word文档分成一页一页的,并分别保存。怎么改可以分成没十页十页,并分别保存呢? 展开
1个回答
展开全部
简单点修改的话,只要修改一个地方就可以了
“For i = 1 To PageCount '设置循环次数”修改为
"For i = 1 To PageCount step 10 '设置循环次数,步长为10
“For i = 1 To PageCount '设置循环次数”修改为
"For i = 1 To PageCount step 10 '设置循环次数,步长为10
更多追问追答
追问
有点问题,只是另存了第一页为一个文件,第十一页为一个文件等等,中间数页没有。
追答
Sub SaveAsPage()
Dim PageCount As Integer, StartRange AsLong, EndRange As Long, MyRange As Range, Fn As String, MyDoc As Document
On Error Resume Next
PageCount =Selection.Information(wdNumberOfPagesInDocument)
Range(0, 0).Select '将光标移至文档起点
For i = 1 To PageCount '设置循环次数
StartRange = Selection.Start '取得该页的第一个字符位置
Selection.EndKey Unit:=wdLine '将光标移动到该页首行的最后位置
Fn = Range(StartRange, Selection.End - 1) '-1的目的是防止该页首行含有段落标记,导致出错.
If i = PageCount Then '如果循环到达最后一页
EndRange = ActiveDocument.Content.End '将文档最后位置赋值于EndRange
Else
Selection.GoToNext (wdGoToPage) '否则,将下一页的起始位置赋值于EndRange(等同于本页的最后位置)
EndRange = Selection.Start
End If
Set MyRange = Range(StartRange, EndRange) '将本页中的内容进行复制
MyRange.Copy
if (i mod 10=0 or i=PageCount then
Set MyDoc = Documents.Add '新建一空白文档
MyDoc.Range(0, 0).Paste '在文档开始处粘贴
MyDoc.SaveAs FileName:=SaveFileName & i & ".doc" '保存文档名
MyDoc.Close '关闭文档
end if
Next
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询