求助：如何将一个多页的word文档按页批量生成新word文件！

守柔

    For Each oPage In ThisDoc.ActiveWindow.ActivePane.Pages
        '取得文档的文本层内容,此处的Item可根据实际情况修改,其值为0-5
        Set myRange = oPage.Rectangles(1).Range
        '取得一个以段落标记为分隔符的一维数组
        myArray = VBA.Split(myRange.Text, Chr(13))
        '将所有文本合并为一个字符串
        PageString = VBA.Join(myArray, "")
        '取得文档中每节的页面设置
        With myRange.Sections(1).PageSetup
            sinLeft = .LeftMargin    '左页边距
            sinRight = .RightMargin    '右页边距
            sinTop = .TopMargin    '上边距
            sinBottom = .BottomMargin    '下边距
            pgOrientation = .Orientation    '纸张方向
        End With
        For Each oChar In ErrChar    '进行一系列替换,即删除无效字符
            PageString = VBA.Replace(PageString, oChar, "")
        Next
        strName = VBA.Left(PageString, 20)    '取得一个前二十个字符的文件名
        strName = strName & ".doc"
        myRange.Copy    '复制

守柔

        Set myDoc = Documents.Add(Visible:=False)    '新建一个隐藏的空白文档
        With myDoc
            .Content.Paste    '粘贴
            .Content.Paragraphs.Last.Range.Delete    '删除最后一个段落标记
            With .PageSetup    '进行页面设置
                .Orientation = pgOrientation
                .LeftMargin = sinLeft
                .RightMargin = sinRight
                .TopMargin = sinTop
                .BottomMargin = sinBottom
            End With
            '如果有相同的文档,则自动随时间序数命名
            If VBA.Dir(myFolder & strName, vbDirectory) <> "" Then strName = Timer & ".doc"
            .SaveAs myFolder & strName    '另存为
            .Close    '关闭文档
        End With
    Next
    ThisDoc.Characters(1).Copy    '变相清空剪贴板
    Application.ScreenUpdating = True    '恢复屏幕更新
    sinEnd = Timer    '取得代码运行结束的时间
    If MsgBox("分页保存结束,用时:" & sinEnd - sinStart & _
              "秒,是否打开指定文件夹查看分页保存后的文档情况?", vbYesNo, myMsgTitle) = vbYes Then _
       ThisDoc.FollowHyperlink myFolder
    Exit Sub
ErrHandle:
    MsgBox "错误号:" & Err.Number & vbLf & "出错原因:" & Err.Description, myMsgTitle
    Err.Clear
    Application.ScreenUpdating = True    '恢复屏幕更新
End Sub
'----------------------

我会抽空另外做一个适宜于其他版本的分页保存程序。

hhb6085

sKJVUG71.rar (701 Bytes, 下载次数: 289)

2007-3-3 17:38 上传

点击文件名下载附件
求助：如何将一个多页的word文档按页批量生成新word文件！

将文件解压到任何地方,最好是桌面.

将你的文件拖到脚本文件图标上.看看是不是你想要的结果.别担心,并不会破坏原文件的.

也许过程有点慢

rrjg

守柔兄：

   谢谢！顷刻间解决了大问题！

chury11

xiexie

chury11

QUOTE:

以下是引用c81在2007-3-1 14:02:30的发言：

吾有一简法，不知可行否：

将每处你要分割的头句话设置成一个大纲级别（如果不是，用查找替换等方法生成），如1级，切换到大纲视图下，Ctrl+A后，点工具“创建子文档”，然后点保存，Word会问你放的位置，确定即可，文档就分开了，而且都是以头句为标题的。

可是，如果把创建的子文档删除后，原文件就打不开了？如图

wwwe

[em06][em06]

tangqingfu

To 守版：

能否做个通用版本？

同时发现批量生成的新文档的视图模式都是普通视图，而不是页面视图，能否加以改进一下？

[此贴子已经被作者于2008-6-1 20:48:34编辑过]

山风点伙

好帖有用收了

Irely

真是好东西啊！