word中的一页自动生成一个文件

szqhb

原帖由 lan_yu 于 2010-10-22 22:08 发表

这个可以完成，但不支持页面设置为横向的文档。因为默认生成的文档都是竖向的。

需要横向页面，请在                Documents.Add.Content.FormattedText = myDoc.Range(IIf(n = 2, 0, myStart), .Start).FormattedText之后加入
               
               
ActiveDocument.PageSetup.Orientation = wdOrientLandscape'横向页面

cycyaya

很高兴找到这个帖子，最近也有一个问题需要用到这个方法去解决，试了下，确实可以分离成一个个文档，但是分离后的文档表格格式不见了。乱了。还有宏运行完会报错。有没有大神帮我看看，谢谢谢谢！！！！

这是我另起的贴子：http://club.excelhome.net/thread-1324099-1-1.html

以下是我上传的附件。

2016年10月工资表（样版）word格式.zip (23.44 KB, 下载次数: 1)

2017-1-15 16:01 上传

点击文件名下载附件

cycyaya

szqhb 发表于 2011-3-7 08:38
需要横向页面，请在                Documents.Add.Content.FormattedText = myDoc.Range(IIf(n = 2, 0,  ...

大神能不能帮我看看我上传的文档，用你给的这个代码不知道为什么拆分后表格会乱码，万分感谢！

jaffedream

用这个也是可以的，而且可以自定义分割的页数：http://blog.sina.com.cn/s/blog_60e52249010194z5.html

13907933959

jaffedream 发表于 2017-3-16 09:10
用这个也是可以的，而且可以自定义分割的页数：http://blog.sina.com.cn/s/blog_60e52249010194z5.html

网友好！
您这个链接内的代码能分割？我试了代码怎么运行不了。我的 office版本是2003的。

jaffedream

13907933959 发表于 2017-3-16 16:29
网友好！
您这个链接内的代码能分割？我试了代码怎么运行不了。我的 office版本是2003的。

可以分割啊，你把代码Const nSteps = 200里的200改小一点，改成1或2。默认是200页分割一次的。如果是1页分割一次，nSteps + 1中删掉+1。

13907933959

jaffedream 发表于 2017-3-16 17:59
可以分割啊，你把代码Const nSteps = 200里的200改小一点，改成1或2。默认是200页分割一次的。如果是1页 ...

网友好！
我反复试了多遍都是提示：运行时错误‘4605’此方法或属性无效，因为未选定文字。
进代码窗口查看，发现这句 oSrcDoc.Bookmarks("\page").Range.Copy 语句，被黄色“突出显示”。恳请您指教，谢谢！

Option Explicit
Sub MyPg()
    Dim oSrcDoc As Document, oNewDoc As Document
    Dim strSrcName As String, strNewName As String
    Dim oRange As Range
    Dim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As Integer
    Dim fso As Object
    Const nSteps = 2   '修改这里控制每隔几页分割一次。
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oSrcDoc = ActiveDocument
    Set oRange = oSrcDoc.Content
    nTotalPages = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
    oRange.Collapse wdCollapseStart
    oRange.Select
    For nIndex = 1 To nTotalPages Step nSteps
    Set oNewDoc = Documents.Add
    If nIndex + nSteps > nTotalPages Then
    nBound = nTotalPages
    Else
    nBound = nIndex + nSteps - 1
    End If
    For nSubIndex = nIndex To nBound
    oSrcDoc.Activate
    oSrcDoc.Bookmarks("\page").Range.Copy
    oSrcDoc.Windows(1).Activate
    Application.Browser.Target = wdBrowsePage
    Application.Browser.Next
    oNewDoc.Activate
    oNewDoc.Windows(1).Selection.Paste
    Next nSubIndex
    strSrcName = oSrcDoc.FullName
    strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
    fso.GetBaseName(strSrcName) & "_" & (nIndex \ nSteps + 1) & "." & fso.GetExtensionName(strSrcName))
    oNewDoc.SaveAs strNewName
    oNewDoc.Close False
    Next nIndex
    Set oNewDoc = Nothing
    Set oRange = Nothing
    Set oSrcDoc = Nothing
    Set fso = Nothing
    MsgBox "结束！"
End Sub

jaffedream

13907933959 发表于 2017-3-17 06:50
网友好！
我反复试了多遍都是提示：运行时错误‘4605’此方法或属性无效，因为未选定文字。
进代码窗口 ...

我用office2003和office2016测试这个代码均无问题，不需要修改这句啊，你换台电脑试试看，或者进虚拟机系统试试看。

13907933959

jaffedream 发表于 2017-3-17 14:23
我用office2003和office2016测试这个代码均无问题，不需要修改这句啊，你换台电脑试试看，或者进虚拟机系 ...

网友好！
好的，用其它的电脑再测试一下，谢谢您！