如何按指定页数拆分word文档 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

比如一个word文档有30页,要拆分成十个word文档,每个文档都是3页,请问老师怎么操作?

比如

选中1~3页

Dim rng As MSWord.Range = Doc.Range(Start:=1, End:=3)

rng.copy

新Doc文档.Content.Paste()

新Doc文档.save.........

老师好,不是很明白怎么用,

还有就是如果是要将指定的页码另存为pdf怎么实现?

就是获取页数，然后遍历，步长设置为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

Dim rng As MSWord.Range = Doc.Range(Start:=1, End:=3)

下面这个不懂的怎么实际编写,可以麻烦老师给一个完整的代码吗,麻烦啦

rng.copy

新Doc文档.Content.Paste()

新Doc文档.save.........

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

……

Dim wjm As String = "纸质"

Dim app As New MSWord.Application

Dim fileName1 = "F:\CS20200310001\" & wjm & "水印.docx"

Dim fileName2 = "F:\CS20200310001\" & wjm & "水印2.docx"

FileSys.CopyFile(fileName1 , fileName2 ,True)

ShowAppWindow( wjm & "水印2.docx",5)

Dim doc = app.Documents.Open(fileName2)

'''添加水印,带页眉页脚

For i As Integer = 1 To 2

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 rng As MSWord.Range = doc.Range(Start:=i, End:=i)

rng.copy

Dim doc2 = app.Documents.Open(fileName2.replace(".docx", i & "000.docx"))

doc2.Content.Paste()

doc2.save

'app.Documents(fileName2.replace(".docx","." & i & "docx")).ExportAsFixedFormat(fileName2.replace(".docx","." & i & "pdf")), MSWord.WdExportFormat.wdExportFormatPDF)

Output.Show("3.3---" & Date.Now)

app.Quit

老师,会提示下面这个错误

我希望得到的结果是,比如一份文档有4页,前2页导出为一份pdf文件,后2页也导出为1份pdf文件

上面蓝色的代码是整份文档导出为pdf,而不是单页pdf

此主题相关图片如下：微信截图_20220318120012.png

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)

app.Quit

下载信息 [文件大小：下载次数： ]
点击浏览该文件:纸质水印.zip

老师,这个第一节的水印没有保存下来呢,如何做可以保存每一页的水印?

水印只能是到新文档也就是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"))

主题：如何按指定页数拆分word文档