whdream 2013-06-02 14:07 采纳率: 0%
浏览 2519

修改VBA分割WORD代码 改成文件名为知道区域文字

Sub SplitEveryFivePagesAsDocuments()
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 = 1

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

  • 写回答

1条回答 默认 最新

  • 码界一棵葱 2016-08-19 02:53
    关注

    请问你的问题解决了么,我碰到和你一样的问题!

    评论

报告相同问题?

悬赏问题

  • ¥15 求差集那个函数有问题,有无佬可以解决
  • ¥15 【提问】基于Invest的水源涵养
  • ¥20 微信网友居然可以通过vx号找到我绑的手机号
  • ¥15 寻一个支付宝扫码远程授权登录的软件助手app
  • ¥15 解riccati方程组
  • ¥15 display:none;样式在嵌套结构中的已设置了display样式的元素上不起作用?
  • ¥15 使用rabbitMQ 消息队列作为url源进行多线程爬取时,总有几个url没有处理的问题。
  • ¥15 Ubuntu在安装序列比对软件STAR时出现报错如何解决
  • ¥50 树莓派安卓APK系统签名
  • ¥65 汇编语言除法溢出问题