- 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=175760)
-- 发布时间：2022/3/17 21:19:00
-- 如何按指定页数拆分word文档
比如一个word文档有30页,要拆分成十个word文档,每个文档都是3页,请问老师怎么操作?
-- 发布时间：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.........
-- 发布时间：2022/3/18 9:49:00
--
老师好,不是很明白怎么用,
还有就是如果是要将指定的页码另存为pdf怎么实现?
-- 发布时间：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
-- 发布时间：2022/3/18 11:19:00
--
Dim rng As MSWord.Range = Doc.Range(Start:=1, End:=3)
下面这个不懂的怎么实际编写,可以麻烦老师给一个完整的代码吗,麻烦啦
rng.copy
新Doc文档.Content.Paste()
新Doc文档.save.........
-- 发布时间：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
……
-- 发布时间：2022/3/18 12:08:00
--
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)
Next
app.Quit
老师,会提示下面这个错误
我希望得到的结果是,比如一份文档有4页,前2页导出为一份pdf文件,后2页也导出为1份pdf文件
上面蓝色的代码是整份文档导出为pdf,而不是单页pdf
此主题相关图片如下：微信截图_20220318120012.png
-- 发布时间：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
-- 发布时间：2022/3/18 18:03:00
--
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:纸质水印.zip |
老师,这个第一节的水印没有保存下来呢,如何做可以保存每一页的水印?
-- 发布时间：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"))