作者：绿色风
分类：
时间：2022-08-18
浏览：154
楼主
芐雨 |
来自海洋之星的问题
要求：每一页另存为一个03的word文档，并以表格中承办企业的名称命名。
- Sub 每页另存为一个文档_芐雨()
- Dim PageCount As Integer, StartRange As Long, EndRange As Long, MyRange As Range, DocName As String, MyDoc As Document
- Application.ScreenUpdating = False
- PageCount = ActiveDocument.Content.Information(wdNumberOfPagesInDocument) '当前页数
- ActiveDocument.Range(0, 0).Select '将光标移至文档起点
- wordPath = ActiveDocument.Path '原文档路径
- On Error Resume Next
- '创建文档，已存在的自动跳过
- Set fso = CreateObject("scripting.filesystemobject").createfolder(wordPath & "\拆分后文档")
- For i = 1 To PageCount '设置循环次数
- StartRange = Selection.Start '取得该页的第一个字符位置
- If i = PageCount Then '如果循环到达最后一页
- EndRange = ActiveDocument.Content.End '将文档最后位置赋值于EndRange
- Else
- Selection.GoToNext (wdGoToPage) '否则,将下一页的起始位置赋值于EndRange(等同于本页的最后位置)
- EndRange = Selection.Start - 1
- End If
- Set MyRange = ActiveDocument.Range(StartRange, EndRange) '将本页中的内容进行复制
- MyRange.Copy
- Set MyDoc = Documents.Add '新建一空白文档
- MyDoc.Range(0, 0).Paste '在文档开始处粘贴
- DocName = MyDoc.Tables(1).Cell(1, 4).Range.Text '承办企业名称（第一行第四列单元格的文本）
- DocName = Left(DocName, Len(DocName) - 2) '去掉多余的字符
- MyDoc.SaveAs FileName:=wordPath & "\拆分后文档\" & DocName, FileFormat:=wdFormatDocument '保存文档为doc
- MyDoc.Close '关闭文档
- Next
- Application.ScreenUpdating = True
- MsgBox "操作完毕!" & vbCrLf & "请到 文件所在文件夹的拆分后文档 查看！！", vbInformation
- End Sub
 西果东送（西安）.zip
|
2楼
海洋之星 |
不错学习，哈哈 |
3楼
嘉昆2011 |
基础操作，供参考：
 WordSplit.gif
|
4楼
嘉昆2011 |
类似的案例：
如何将邮件合并后的文档拆分成独立文档
(出处: Excel 技巧网)
|
5楼
芐雨 |
能拆分啊
但他不是邮件合并后的文件，怎么用企业名称命名啊 |
6楼
滴水穿石 |
功能好强大！跟着学习~ |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一