应用VBA将长文档word按大纲级别拆分为新文件并另存为PDF
'将长文档中的同一级别的内容分别拆分为一个新文件，并同时以新文件内容第一行为文件
名保存在当前文件夹中。
Sub 按大纲级别拆分文件()
Dim rngrange As Range
Dim doc As Document
Dim i As Integer
Dim j As Integer
Dim mys As String
Dim levi As Integer
Dim levj As Integer
Dim contt As String
Dim spendtimestr As String
Application.ScreenUpdating = False
mypath = ActiveDocument.Path
starttime = Time
For i = 1 To ActiveDocument.Paragraphs.Count
If ActiveDocument.Range.Paragraphs(i).OutlineLevel = wdOutlineLevel2 Then
levi = ActiveDocument.Range.Paragraphs(i).OutlineLevel
Set myRange = ActiveDocument.Paragraphs(i).Range
myRange.SetRange myRange.Start, myRange.End - 1
iFilename = Trim(myRange.Text)
j = i 'J等于i,即找到目标的段落，关键点之一
Do
'从即找到目标的段落i开始，依次往后找，一直到找到级别小于或等于目标段落的段落
或找到文章的最后，关键点之二
j = j + 1
levj = ActiveDocument.Range.Paragraphs(j).OutlineLevel
Loop Until (levj < levi Or levj = levi Or j = ActiveDocument.Paragraphs.Count)
'级别小于或等于目标段落的段落或找到文章的最后，关键点之三
'如果是件末，则将最后一段内容同时拷贝
If j = ActiveDocument.Paragraphs.Count Then
Set rngrange = ActiveDocument.Range(ActiveDocument.Paragraphs(i).Range.Start,
ActiveDocument.Paragraphs(j).Range.End)
rngrange.Select
Selection.Copy
Else
Set rngrange = ActiveDocument.Range(ActiveDocument.Paragraphs(i).Range.Start,
ActiveDocument.Paragraphs(j - 1).Range.End)
rngrange.Select
Selection.Copy
End If
Documents.Add
With ActiveDocument.Content
.Paste
End With
Call 页面设置
ActiveDocument.SaveAs FileName:=mypath & "\" & iFilename, FileFormat:=wdFormatPDF
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
Else
End If
Next i
endtime = Time
spendtime = Round((endtime - starttime) * 24 * 60 * 60, 3)
spendtimestr = "共费时:" & spendtime & "秒"
MsgBox (spendtimestr)
Application.ScreenUpdating = True End Sub
Sub 页面设置()
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait .TopMargin = CentimetersToPoints(2) .BottomMargin = CentimetersToPoints(1.4) .LeftMargin = CentimetersToPoints(1.8) .RightMargin = CentimetersToPoints(1.8) .Gutter = CentimetersToPoints(0) .HeaderDistance = CentimetersToPoints(1.5) .FooterDistance = CentimetersToPoints(1.2) .PageWidth = CentimetersToPoints(14.8) .PageHeight = CentimetersToPoints(21) .FirstPageTray = wdPrinterDefaultBin .OtherPagesTray = wdPrinterDefaultBin .SectionStart = wdSectionNewPage .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False .MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False .BookFoldRevPrinting = False .BookFoldPrintingSheets = 1 .GutterPos = wdGutterPosLeft .LayoutMode = wdLayoutModeLineGrid
End With
End Sub
本文档为【应用VBA将长文档word按大纲级别拆分为新文件并另存为PDF】，请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑，
图片更改请在作品中右键图片并更换，文字修改请直接点击文字进行修改，也可以新增和删除文档中的内容。
该文档来自用户分享，如有侵权行为请发邮件ishare@vip.sina.com联系网站客服，我们会及时删除。
[版权声明] 本站所有资料为用户分享产生，若发现您的权利被侵害，请联系客服邮件isharekefu@iask.cn，我们尽快处理。
本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权，请谨慎使用。
网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传，仅限个人学习分享使用，禁止用于任何广告和商用目的。
浙公网安备 33021202002483