怎么将word文档按20页保存？

此用户被禁言

每个月都有一个word文档，，里面有600页的样子，如何使用VBA，将这个word文档，按每20页保存为一个文件。文件名可以按循环的数字来命名就行了

比如1-20页的内容   为1.docx    21-40页的内容保存为2.docx

注意有页脚，与页眉都需要。。。


http://club.excelhome.net/thread-835582-1-1.html?jdfwkey=pfiir2

看了这里的求助，我把2改成20根本不行。。所以不知道如何操作了。

thunor

有个思路，供你参考。倒起剪切。如共613页，那就613-601为第31号文件。余下的类推。

此用户被禁言

thunor 发表于 2015-2-11 21:48
有个思路，供你参考。倒起剪切。如共613页，那就613-601为第31号文件。余下的类推。

老师，能否提供一下代码，谢谢

WORD中的VBA我真是一点不熟悉。。对象也不知道如何操作的。谢谢

pipiludaxian

1、遍历每一页
2、1-20页 设定为一个range     ，copy
3、每复制一个range 即新建一文档
4、新文档saveas  参数用全路径
5、past
6、关闭新建文档 参数用 保存修改

413191246se

请楼主备份原文档后，将原文件放在一个新建文件夹里面，试用下面的宏：
Sub 多页另存()
'将文档每20页保存为一个文档！
'i=20页，p=总页数，j=p/i=保存次数,k=计数器,m=循环变量
    On Error Resume Next
    Dim i As String, docName As String, p As Long, j As Long, k As Long, m As Long
    i = InputBox("请输入要多少页保存为一个文档！", "每N页保存为一个文档", "3")
    If i = "" Then Exit Sub
    docName = ActiveDocument.Name
    docName = Left(docName, Len(docName) - 4)
    p = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
    If i = 1 Then
        j = p / i
    Else
        If i >= p Then MsgBox "错误！超出总页数！请重新设定！", vbOKOnly + vbCritical, "信息": End
        j = Int(p / i) + 1
    End If
    For m = 1 To j
        k = k + 1
        p = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
        If i >= p Then
            Selection.WholeStory
        Else
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=i + 1, Name:=""
            Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
        End If
        Selection.Cut
        Documents.Add.Range.Paste
        ActiveDocument.SaveAs FileName:=docName & "-" & k & ".doc"
        ActiveDocument.Close
        ActiveDocument.Characters(1).Copy '变相清空剪贴板
    Next m
    ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

此用户被禁言

413191246se 发表于 2015-2-12 10:15
请楼主备份原文档后，将原文件放在一个新建文件夹里面，试用下面的宏：
Sub 多页另存()
'将文档每20页保存 ...

谢谢帮助。。。

daisymuxi

感谢楼主分享，有用

dony30mk2

有用，真是学习无止境

Zenray

有用，真是学习无止境