应用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)