|
|
楼主 |
发表于 2023-8-3 10:58
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
合并PDF.rar
(236.37 KB, 下载次数: 104)
纯VBA代码 合并多个PDF文件成一个PDF文件
- Rem *****************************************************************************************
- Rem 函数名： AppendPDFs
- Rem 函数功能：合并一个PDF文件集（多个PDF文件,最少要1个文件），追加也一样的
- Rem 返回值： 返回是否成功
- Rem 参数1： ARX 字符类型集合 PDF文件集（多个PDF文件）的文件全路径，如果含：strFileName，则此文件也会被合并
- Rem 参数2： StrFileName 字符类型 合成后的PDF文件保存全路径，如果已经存在，则会被替换内容
- Rem 使用方法： 与函数：FileAllArr 配合使用，注意要使用：全路径
- ''' Dim ARX, FileArr
- ''' FileArr = FileAllArr(ThisWorkbook.Path, "*.pdf", ThisWorkbook.Name, True, False) '//含子文件夹；文件路径
- ''' For X = 0 To UBound(FileArr)
- ''' ReDim Preserve ARX(X)
- ''' ARX(X) = ThisWorkbook.Path & "" & FileArr(X) '//需要全路径
- ''' Next X
- ''' MsgBox AppendPDFs(ARX, ThisWorkbook.Path & "\630.pdf") '//保存 文件
- Rem 整理：北极狐工作室 QQ：14885553
- '*****************************************************************************************
- Public Function AppendPDFs(ARX, StrFileName As String) As Boolean
- 'On Error Resume Next
- Rem '//必要时需引用：Adobe Acrobat 10.0 Type Library （版本可能不一样）
- Dim AcroApp As Acrobat.AcroApp
- Dim AvCodeFile As Acrobat.AcroAVDoc
- Dim PDDoc1 As Acrobat.AcroPDDoc
- Dim PDDoc2 As Acrobat.AcroPDDoc
-
- Dim I As Long
- Dim lngPage As Long
- Dim lngPageNum1 As Long
- Dim lngPageNum2 As Long
- Dim lngPageNum3 As Long
-
- lngPageNum1 = 0
- lngPageNum2 = 0
- lngPageNum3 = 0
-
- If LBound(ARX) = UBound(ARX) Then
- Rem 如果只有一个文件则直接复制
- FileCopy ARX(LBound(ARX)), StrFileName ' 将源文件的内容复制到目的文件中。
- Else
- Rem 'Start Acrobat in the background
- Set AcroApp = CreateObject("AcroExch.App")
- AcroApp.Hide
- Set AvCodeFile = CreateObject("AcroExch.AVDoc")
-
- AvCodeFile.Open ARX(LBound(ARX)), ARX(LBound(ARX)) '//打开第一个PDF文件
- Set PDDoc1 = AvCodeFile.GetPDDoc
- lngPageNum1 = PDDoc1.GetNumPages '//记录页数
- lngPageNum3 = 0
-
- For I = LBound(ARX) + 1 To UBound(ARX) '//分别打开其他的PDF
-
- Set PDDoc2 = CreateObject("AcroExch.PDDoc")
- PDDoc2.Open ARX(I)
-
- lngPage = PDDoc1.GetNumPages - 1 '//获取此文件的页数
- If lngPage < 0 Then lngPage = 0
-
- PDDoc1.InsertPages lngPage, PDDoc2, 0, PDDoc2.GetNumPages, 0 '//向已经打开的PDF追加其他PDF
- lngPageNum3 = lngPageNum3 + PDDoc2.GetNumPages '//记录合并后的页数
-
- Rem 关闭后打开的文件
- PDDoc2.Close
- Set PDDoc2 = Nothing
- Next I
-
- PDDoc1.Save 1, StrFileName '//保存，如果不存在就新建，存在就替换
- lngPageNum2 = PDDoc1.GetNumPages '//合并后的总页数
- PDDoc1.Close
-
- AvCodeFile.Close 0
-
- Rem 'Exit Acrobat
- AcroApp.Exit
-
- Set AcroApp = Nothing
- Set AvCodeFile = Nothing
- Set PDDoc1 = Nothing
- End If
- If lngPageNum2 - lngPageNum1 = lngPageNum3 Then '//如果页数相加正确
- AppendPDFs = True
- Else
- AppendPDFs = False
- End If
-
- End Function
|
|
楼主: opiona
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-7-14 17:42
