求一键拆分word文档软件

查看 83|回复 5
作者:YMZ2000   
求求各位大神有没有能实现一键拆分word文档的软件,就是本来原word文档是一百多页,想要拆分成一页一个word文档

文档, 一键

星星相惜d   

WPS有,我有会员,发我我帮你拆
仙鬼同拥   

善用论坛搜索,这个帖子里的工具可以https://www.52pojie.cn/thread-1190435-1-1.html
Jadeglass   

开一个会员嘛
YMZ2000
OP
  


仙鬼同拥 发表于 2023-3-13 14:02
善用论坛搜索,这个帖子里的工具可以https://www.52pojie.cn/thread-1190435-1-1.html

我下载了也安装了,但是不知道为什么打不开
mmmmmmmm   

在文件夹内打开那个需要按页拆分的文档
键入ALT+F11打开VBA编辑器(或者点击“开发工具”选项卡,点击"visual basic,进入VBA编辑器)。点击“插入-模块”,将下面一段VBA代码复制粘贴到该新建的模块中。
Option Explicit
Sub SplitPagesAsDocuments()
Dim oSrcDoc As Document, oNewDoc As Document
Dim strSrcName As String, strNewName As String
    Dim oRange As Range
    Dim nIndex As Integer
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oSrcDoc = ActiveDocument
    Set oRange = oSrcDoc.Content
    oRange.Collapse wdCollapseStart
    oRange.Select
    For nIndex = 1 To ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
       oSrcDoc.Bookmarks("\page").Range.Copy
        oSrcDoc.Windows(1).Activate
        Application.Browser.Target = wdBrowsePage
        Application.Browser.Next
        strSrcName = oSrcDoc.FullName
        strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
                    fso.GetBaseName(strSrcName) & "_" & nIndex & "." & fso.GetExtensionName(strSrcName))
        Set oNewDoc = Documents.Add
        Selection.Paste
        oNewDoc.SaveAs strNewName
        oNewDoc.Close False
    Next
    Set oNewDoc = Nothing
    Set oRange = Nothing
    Set oSrcDoc = Nothing
    Set fso = Nothing
    MsgBox "结束!"
End Sub
点击上方的“运行-运行子过程/窗体”,稍等几秒会弹出一个拆分成功结束的提示框,点击“确定”后关闭VBA窗口,打开文件夹,发现已经拆分完成了,出现2个独立的Word文档。
您需要登录后才可以回帖 登录 | 立即注册

返回顶部