Foxtable(狐表) → 用户栏目 → 专家坐堂 → 如何按指定页数拆分word文档


  共有4736人关注过本帖树形打印复制链接

主题：如何按指定页数拆分word文档
帅哥，在线噢！
有点蓝
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：112393 积分：572233 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2022/3/17 21:48:00 [显示全部帖子]

比如

选中1~3页

Dim rng As MSWord.Range = Doc.Range(Start:=1, End:=3)
rng.copy
新Doc文档.Content.Paste()
新Doc文档.save.........
 回到顶部
帅哥，在线噢！
有点蓝
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：112393 积分：572233 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2022/3/18 10:07:00 [显示全部帖子]

就是获取页数，然后遍历，步长设置为3

for i as integer = 1 to 30 step 3
Dim rng As MSWord.Range = Doc.Range(Start:=i, End:=i+2)

到pdf参考http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=49847
 回到顶部
帅哥，在线噢！
有点蓝
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：112393 积分：572233 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2022/3/18 11:36:00 [显示全部帖子]

Dim app As New MSWord.Application
    Dim doc = app.Documents.Open("f:\123.doc")
Dim rng As MSWord.Range = Doc.Range(Start:=1, End:=3)
rng.copy
    Dim 新Doc文档 = app.Documents.Open("f:\456.doc")
新Doc文档.Content.Paste()
新Doc文档.save
……
 回到顶部
帅哥，在线噢！
有点蓝
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：112393 积分：572233 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2022/3/18 14:35:00 [显示全部帖子]

Dim wjm As String = ""
Dim app As New MSWord.Application
Dim fileName1 = "D:\问题\" & wjm & "test2.docx"
Dim fileName2 = "D:\问题\" & wjm & "test3.docx"
FileSys.CopyFile(fileName1 , fileName2 ,True)
Dim doc = app.Documents.Open(fileName2)
dim 总页数 as integer = 4
dim 页数  as integer = 2
For i As Integer = 1 To 总页数 Step 页数
    Output.Show("3.1---" & Date.Now)
    'doc.Activate
    'doc.Sections(1).Range.Select  '数字为第几节
    'app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader '插入水印前需更改视图样式为页眉视图
    'app.Selection.HeaderFooter.Shapes.AddPicture(ProjectPath & "Images\yemei.png",  False, True,-23, -20, 570, 85)
    'app.Selection.HeaderFooter.Shapes.AddPicture(ProjectPath & "Images\yejiao.png", False, True,-23, 760, 570, 50)
    'app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekMainDocument '恢复视图样式到原来样式
    'Output.Show("3.2---" & Date.Now)
    '
    Dim range1 = doc.GoTo(MSWord.WdGoToItem.wdGoToPage, MSWord.WdGoToDirection.wdGoToAbsolute, i, Nothing)
    Dim range2 = doc.GoTo(MSWord.WdGoToItem.wdGoToPage, MSWord.WdGoToDirection.wdGoToAbsolute, i+页数, Nothing)
    Dim ed As Integer = range2.Start - 1
    If  i +页数 >= 总页数
        ed = Doc.Characters.Count
    End If
    Dim rng As MSWord.Range = doc.Range(Start:=range1.Start, End:=ed)
    rng.copy()
    Dim doc2 = app.Documents.add
    doc2.Content.Paste()
    doc2.SaveAs(Filename:=fileName2.replace(".docx", i & "000.docx"))
    'app.Documents(fileName2.replace(".docx","." & i & "docx")).ExportAsFixedFormat(fileName2.replace(".docx","." & i & "pdf")), MSWord.WdExportFormat.wdExportFormatPDF)
    Output.Show("3.3---" & Date.Now)
Next
app.Quit
 回到顶部
帅哥，在线噢！
有点蓝
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：112393 积分：572233 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2022/3/19 9:05:00 [显示全部帖子]

水印只能是到新文档也就是doc2里另外手工添加

    Dim rng As MSWord.Range = doc.Range(Start:=range1.Start, End:=ed)
    rng.copy()
    Dim doc2 = app.Documents.add
    doc2.Content.Paste()
在这里添加水印的处理代码
    doc2.SaveAs(Filename:=fileName2.replace(".docx", i & "000.docx"))
 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.04297 秒, 5 次数据查询