以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  [求助]把Word拆分成一页一个文档  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=143358)
--  作者：天一生水
--  发布时间：2019/11/21 20:22:00
--  [求助]把Word拆分成一页一个文档
老师好！
我有一个Word文档，内容是从数据表连续生成的格式相同的数据文档，我想把它拆分为1页1个（或n页1个）的小文档；
我获取了Word文档的页数后，后面应该怎样操作？
谢谢！

Dim app As New MSWord.Application
try
    Dim fileName = "E:\\test.doc"
    Dim doc = app.Documents.Open(fileName)   
    Dim y = doc.ComputeStatistics(Microsoft.Office.Interop.Word.WdStatistic.wdStatisticPages, Nothing)
    ’msgbox(y)   ’Word页数
    For i AS integer = 1 To y

......

catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try
--  作者：有点蓝
--  发布时间：2019/11/22 13:48:00
--  
新建一个文件，把内容复制过去，保存....
--  作者：天一生水
--  发布时间：2019/11/22 16:56:00
--  

请老师给改改，每一页怎样复制？

谢谢！

 

Dim app As New MSWord.Application    \'原文件
Dim wapp As New MSWord.Application     \'拆分文件
try
    Dim fileName = "d:\\test.doc"
    Dim doc = app.Documents.Open(fileName)
    Dim y = doc.ComputeStatistics(Microsoft.Office.Interop.Word.WdStatistic.wdStatisticPages, Nothing)
    \'msgbox(y)   \'Word页数
    For i As Integer = 1 To y
       
        \'新建拆分
        Dim missing = System.Reflection.Missing.Value
        Dim nDoc = wapp.Documents.Add(missing, missing, missing, missing)
        nDoc.SaveAs(ProjectPath & "Word拆分-" & i & ".doc")
        \'app.quit

 

        app.ActiveWindow.Selection.WholeStory
        app.ActiveWindow.Selection.copy      \'复制
        wapp.ActiveWindow.Selection.WholeStory
        wapp.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
       
        app.quit
    Next
    app.quit
catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try
--  作者：有点蓝
--  发布时间：2019/11/22 20:34:00
--  
参考：https://www.cnblogs.com/CPFlying/archive/2012/02/15/1723724.html