Excel实战技巧43： 将多个PDF文件中指定页面合并成一个PDF文件

学习Excel技术，关注微信公众号：

excelperfect

在《Python实战01：合并多个PDF文件》和《Python实战02：分别合并多个相似文件名的PDF文件》中，我们使用Python代码对PDF文件进行操作来合并PDF文件。其实，使用VBA也能合并PDF文件。

假设在同一文件夹中放置了要合并的PDF文件所在的文件夹、合并后的文件存放的文件夹、以及代码工作簿，其中要合并的文件存放在名为“PDF文件”的文件夹中，合并后的文件放在名为“合并的文件”的文件夹中，如下图1所示。

图1

首先，需要在VBE中设置对“Adobe Acrobat 10.0 Type Library”的引用。在VBE中，单击菜单“工具——引用”，在“引用”对话框中找到并选取“Adobe Acrobat 10.0 Type Library”，如下图2所示。

图2

注意，如果没有安装相应的Adobe Reader版本，可能找不到这个库。

接下来，编写代码实现合并功能。

下面的代码列出文件夹“PDF文件”中所有的PDF文件名：

Sub ListPDFFiles()

Dim fso As Object

Dim sFolder As Object

Dim fileItem As Object

Dim folderName As String

Dim iRow As Long

folderName = ThisWorkbook.Path &"\PDF文件\"

Set fso =CreateObject("Scripting.FileSystemObject")

Set sFolder = fso.GetFolder(folderName)

With Sheets("Sheet1")

.Columns(1).ClearContents

.Range("A1") = "PDF文件名"

For Each fileItem In sFolder.Files

iRow = .Cells(Rows.Count,1).End(xlUp).Row + 1

.Cells(iRow, 1) = fileItem.Name

Next fileItem

End With

Set fso = Nothing

End Sub

代码运行后的结果如下图3所示。

图3

在上图3所示的工作表中，在每个PDF文件名相邻的单元格，输入要合并的PDF文件页码，如果要合并多页，则用逗号分隔开。例如，数字2表明要合并文件“完美Excel.pdf”的第2页，数字2,6表明要合并文件“汇总.pdf”的第3页和第6页，如下图4所示。

图4

下面的代码将取出要合并的PDF文件中的页面并保存为一个单独的PDF文件：

Sub SplitPDFFilesIntoSinglePages()

'引用 :Adobe Acrobat 10.0 Type Library

'-------------------------------------------

Dim PDDoc As Acrobat.CAcroPDDoc

Dim newPDF As Acrobat.CAcroPDDoc

Dim PDPage As Acrobat.CAcroPDPage

Dim b As Boolean

Dim v As Variant

Dim thePDF As String

Dim newName As String

Dim r As Long

Dim pNum As Long

Dim i As Long

With Sheets("Sheet1")

For r = 2 To .Cells(Rows.Count,1).End(xlUp).Row

thePDF = ThisWorkbook.Path &"\PDF文件\" & .Cells(r, 1)

Set PDDoc =CreateObject("AcroExch.pdDoc")

If Not PDDoc.Open(thePDF) ThenMsgBox "不能打开文件", vbExclamation: Exit Sub

pNum = PDDoc.GetNumPages

For i = 0 To pNum - 1

newName = .Cells(r, 1) &"_" & i + 1 & ".pdf"

b = False

For Each v In Split(.Cells(r,2), ",")

If Val(v) = i + 1 Then b =True: Exit For

Next v

If b Then

Set newPDF =CreateObject("AcroExch.pdDoc")

newPDF.Create

newPDF.InsertPages -1,PDDoc, i, 1, 0

newPDF.Save 1,ThisWorkbook.Path & "\合并的文件\" & newName

newPDF.Close

Set newPDF = Nothing

End If

Next i

Next r

End With

End Sub

运行代码后的结果如下图5所示。

图5

下面的代码将已单独拆分出来的PDF文件合并成一个PDF文件：

Sub MergePDFFilesIntoOne()

'引用 : AdobeAcrobat 10.0 Type Library

'-------------------------------------------

Dim a() As String

Dim myPath As String

Dim myFiles As String

Dim f As String

Dim i As Long

Const destFile As String = "合并.pdf"

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = ThisWorkbook.Path& "\"

.AllowMultiSelect = False

If .Show = False Then Exit Sub

myPath = .SelectedItems(1)

DoEvents

End With

If Right(myPath, 1) <> "\"Then myPath = myPath & "\"

ReDim a(1 To 2 ^ 14)

f = Dir(myPath & "*.pdf")

While Len(f)

If StrComp(f, destFile, vbTextCompare)Then

i = i + 1

a(i) = f

End If

f = Dir()

Wend

If i Then

ReDim Preserve a(1 To i)

myFiles = Join(a, ",")

Application.StatusBar = "合并中, 请等待 ..."

Call MergePDFs(myPath, myFiles,destFile)

Application.StatusBar = False

Else

MsgBox "在下面的路径中没有找到PDF文件 " & vbLf & myPath,vbExclamation, "取消"

End If

End Sub

Sub MergePDFs(myPath As String,myFiles As String, Optional destFile As String = "合并.pdf")

Dim acApp As New Acrobat.AcroApp

Dim pDocs() As Acrobat.CAcroPDDoc

Dim a As Variant

Dim s As String

Dim i As Long

Dim j As Long

Dim n As Long

If Right(myPath, 1) = "\" Then s= myPath Else s = myPath & "\"

a = Split(myFiles, ",")

ReDim pDocs(0 To UBound(a))

On Error GoTo Exit_

If Len(Dir(s & destFile)) Then Kill s& destFile

For i = 0 To UBound(a)

If Dir(s & Trim(a(i))) ="" Then

MsgBox "文件没有找到" & vbLf & s &a(i), vbExclamation, "取消"

Exit For

End If

Set pDocs(i) =CreateObject("AcroExch.PDDoc")

pDocs(i).Open s & Trim(a(i))

If i Then

j = pDocs(i).GetNumPages()

If Not pDocs(0).InsertPages(n - 1,pDocs(i), 0, j, True) Then

MsgBox "不能插入页" & vbLf & s & a(i),vbExclamation, "取消"

End If

n = n + j

pDocs(i).Close

Set pDocs(i) = Nothing

Else

n = pDocs(0).GetNumPages()

End If

Next i

If i > UBound(a) Then

If Not pDocs(0).Save(PDSaveFull, s& destFile) Then

MsgBox "不能在下面的文件中保存最终的结果文档" & vbLf &s & destFile, vbExclamation, "取消"

End If

End If

Exit_:

If Err Then

MsgBox Err.Description, vbCritical,"错误 #" & Err.Number

ElseIf i > UBound(a) Then

MsgBox "创建的结果文件是:" & vbLf & s &destFile, vbInformation, "完成"

End If

If Not pDocs(0) Is Nothing ThenpDocs(0).Close

Set pDocs(0) = Nothing

acApp.Exit

Set acApp = Nothing

End Sub

运行代码后，要求你选择要合并的PDF文件所在的文件夹，因为我们将拆出的单独的PDF文件放置在了“合并的文件”文件夹中，应此选该文件夹，如下图6所示。

图6

合并完成后，会弹出如图7所示的提示信息。

图7

下图8为合并后的PDF文件。

图8

与Python代码相比，VBA代码有点多了！

下面是上述代码的图片版。

注：这是在wellsr.com上学习并整理的技巧，转载请注明出处。