Office中国论坛/Access中国论坛

标题: 自制PDF合并小工具 [打印本页]

---

作者: worryd1    时间: 2023-11-12 22:29
标题: 自制PDF合并小工具

因工作需要打印大量的发票，两张打印一张A4纸正好，而合并软件收费居多而且不方便，所以自己做了一个（也都是网上查和总结的）希望对大家有帮助
1，先安装 Adobe Acrobat 软件，然后添加acrobat access 3.0 Type Libarry 引用
2，分别设置了合并文件夹内所有PDF文件，和选择PDF文件合并两种方式3，因为级别不够不能发附件，把源码直接发出来

[free]

1. Private Sub 合并PDF1_Click()
   
2. 'On Error GoTo ErrorHandler:
   
3. Dim PDFdoc As Object, TempPDFdoc As Object
   
4. Dim PageNum As Long
   
5. Dim PDFFolder As String, PDFFileName As String
   
6. If Len(Nz(Me.SaveFile, "")) = 0 Then
   
7.     Call SaveFile_Click
   
8.     Exit Sub
   
9. End If
   
10. PDFFolder = Me.SaveFile & ""
    
11. Set PDFdoc = CreateObject("AcroExch.PDDoc")
    
12. Set TempPDFdoc = CreateObject("AcroExch.PDDoc")
    
13. 
    
14. TempPDFdoc.Create
    
15. 
    
16. 
    
17. For i = 0 To Me.plist.ListCount - 1
    
18.     PDFFileName = Me.plist.ItemData(i)
    
19.     If PDFdoc.Open(PDFFileName) Then
    
20.         PageNum = PDFdoc.GetNumPages
    
21.         TempPDFdoc.InsertPages TempPDFdoc.GetNumPages - 1, PDFdoc, 0, PageNum, 0
    
22.         PDFdoc.Close
    
23.     End If
    
24. Next
    
25. 
    
26. 
    
27. 
    
28.     With TempPDFdoc
    
29.         .Save PDSaveFull, PDFFolder & "合并.pdf"
    
30.         .Close
    
31.     End With
    
32. 
    
33. 
    
34. Exithere:
    
35. 
    
36.     Exit Sub
    
37. 
    
38. ErrorHandler:
    
39.         MsgBox Err.Description, vbInformation, "提示"
    
40.         Resume Exithere
    
41. End Sub
    
42. 
    
43. Private Sub PDF选择按钮_Click()
    
44.     With Application.FileDialog(3)
    
45.         .AllowMultiSelect = False
    
46.         .Filters.Clear
    
47.         .Filters.Add *.pdf"
    
48.         If .Show Then Me.plist.AddItem .SelectedItems(1)
    
49.     End With
    
50. End Sub
    
51. 
    
52. 
    
53. Sub 合并PDF文件()
    
54. Dim PDFdoc As Object, TempPDFdoc As Object
    
55. Dim PageNum As Long
    
56. Dim PDFFolder As String, PDFFileName As String
    
57. PDFFolder = Me.SourceFile & ""
    
58. Set PDFdoc = CreateObject("AcroExch.PDDoc")
    
59. Set TempPDFdoc = CreateObject("AcroExch.PDDoc")
    
60. TempPDFdoc.Create
    
61. PDFFileName = Dir(PDFFolder & "*.pdf")
    
62. Do
    
63.     If PDFdoc.Open(PDFFolder & PDFFileName) Then
    
64.         PageNum = PDFdoc.GetNumPages
    
65.         TempPDFdoc.InsertPages TempPDFdoc.GetNumPages - 1, PDFdoc, 0, PageNum, 0
    
66.         PDFdoc.Close
    
67.     End If
    
68.     PDFFileName = Dir
    
69. Loop Until PDFFileName = ""
    
70. With TempPDFdoc
    
71.     .Save PDSaveFull, PDFFolder & "合并.pdf"
    
72.     .Close
    
73. End With
    
74. Set PDFdoc = Nothing
    
75. Set TempPDFdoc = Nothing
    
76. End Sub
    

复制代码

---

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)

Powered by Discuz! X3.3