专栏首页完美ExcelExcel实战技巧43: 将多个PDF文件中指定页面合并成一个PDF文件

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上学习并整理的技巧,转载请注明出处。

本文分享自微信公众号 - 完美Excel(excelperfect),作者:fanjy

原文出处及转载信息见文内详细说明,如有侵权,请联系 yunjia_community@tencent.com 删除。

原始发表时间:2019-04-12

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

我来说两句

0 条评论
登录 后参与评论

相关文章

  • Excel应用实践22: 比较并合并工作表

    有两个工作表,均含有相同的数据,但最后一列名称和产品的数量不同,如下图1和图2所示。

    fanjy
  • VBA实用小程序61: 在文件夹内所有文件中运行宏/在工作簿所有工作表中运行宏

    在文件夹中所有文件上运行宏,或者在Excel工作簿中所有工作表上运行宏,这可能是一种非常好的Excel自动化方案。例如处理类似的数据工作簿文件并想要提取数据或转...

    fanjy
  • Excel应用实践16:搜索工作表指定列范围中的数据并将其复制到另一个工作表中

    “在工作表Sheet1中存储着数据,现在想要在该工作表的第O列至第T列中搜索指定的数据,如果发现,则将该数据所在行复制到工作表Sheet2中。

    fanjy
  • VB.NET DATAGRIDVIEW数据导出Excel

    Dim rowc As Integer = prt_dgv.Rows.Count

    巴西_prince
  • 视频教程 | 10行C++,搭建一个电影推荐人工智能系统

    推荐系统在我们的身边无处不在,基本每一个网络都会基于用户的爱好展示相关的产品。有时候它很隐蔽,你都没有察觉。他们可以使网页上的内容更加定制化,从而帮公司挣钱。 ...

    AI科技大本营
  • 正确理解Linux运行级别那点事儿

    您可以将Linux运行级别视为操作系统运行的不同“模式”。每一种模式或运行级别都有自己的进程和服务列表,这些进程和服务要么被打开,要么被关闭。

    用户6543014
  • java分布式面试题之消息队列ActiveMQ部分

    如果是传统的集中式架构,实现这个功能非常简单:开启一个本地事务,往本地数据库中插入一条用户数据,发送验证码,提交事物。但是在分布式架构中,用户和发送验证码是两个...

    Java搬砖工人
  • 2015.5 技术雷达 | 工具篇

    (点击图片可以查看大图) 尽管依赖管理的概念并不新奇,在很多技术栈下它甚至已经被作为一种基础开发实践,但在PHP 社区却并非如此。Composer(getcom...

    ThoughtWorks
  • python之platform模块

    python中,platform模块给我们提供了很多方法去获取操作系统的信息 如:

    菲宇
  • Mysql-13mysql的复制

    1.mysql复制概念   指将主数据库的DDL和DML操作通过二进制日志传到复制服务器上,然后在复制服务器上将这些日志文件重新执行,从而使复制服务器和主服务器...

    用户1173509

扫码关注云+社区

领取腾讯云代金券