批量打印PDF文件（电信电子发票），PDF文件导出图片

microyip

上月因为电信缴费转我这里处理，缴费后收了上百个电子发票，都是PDF文件，傻眼了，写了个VBA去利用Acrobat的打印功能批量打印，结果出来的全部是A4纸，又因赶时间报销处理，就不理了，直接交财务，结果……不过最后就那样算了。
本月又来了，研究了一下，直接打印，很难设定打印纸型，换个思路咯，把PDF文件导出图片，然后引入Excel打印，方便修改尺寸，结果发现引入图片后，刚好是比A5纸大一点点，于是把引入的页面调整为95%打印，出来的效果超好。特意分享给大家使用，如果大家有更好的方法，不妨也分享一下。

1. Sub PrintInvoice()
   
2.     Dim vFile As Variant, sPath As String, sPDF As String, nI As Integer
   
3.     Dim acroApp As Acrobat.acroApp
   
4.     Dim acroAVDoc As Acrobat.acroAVDoc
   
5.     Dim acroPDDoc As Acrobat.acroPDDoc
   
6.     Dim oJSO As Object
   
7. 
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.     vFile = Application.GetOpenFilename("PDF 文件,*.pdf")
    
11.     If vFile = False Then Exit Sub
    
12.     sPath = vFile
    
13.     vFile = Split(sPath, "")
    
14.     sPath = Left(sPath, Len(sPath) - Len(vFile(UBound(vFile))))
    
15.    
    
16.     sPDF = Dir(sPath & "*.pdf")
    
17.     ReDim vFile(1 To 1)
    
18.    
    
19.     Do While sPDF <> ""
    
20.         nI = nI + 1
    
21.         ReDim Preserve vFile(1 To nI)
    
22.         vFile(nI) = sPDF
    
23.         sPDF = Dir
    
24.     Loop
    
25.     If nI = 0 Then Exit Sub
    
26.    
    
27.     Set acroApp = CreateObject("AcroExch.App")
    
28.     Set acroAVDoc = CreateObject("AcroExch.AVDoc")
    
29.     For nI = 1 To UBound(vFile)
    
30.         If acroAVDoc.Open(sPath & vFile(nI), "文档转换") Then
    
31.             Set acroPDDoc = acroAVDoc.GetPDDoc()
    
32.             Set oJSO = acroPDDoc.GetJSObject
    
33.             oJSO.SaveAs sPath & "发票.jpg", "com.adobe.acrobat.jpeg"
    
34.             acroApp.CloseAllDocs
    
35.             PrintPic sPath & "发票.jpg"
    
36.         End If
    
37.     Next
    
38.     acroApp.Exit
    
39.     Set oJSO = Nothing
    
40.     Set acroPDDoc = Nothing
    
41.     Set acroAVDoc = Nothing
    
42.     Set acroApp = Nothing
    
43.     If Dir(sPath & "发票.jpg") <> "" Then Kill sPath & "发票.jpg"
    
44.     Application.DisplayAlerts = True
    
45.     Application.ScreenUpdating = True
    
46.     MsgBox "打印结束！"
    
47. End Sub
    
48. 
    
49. Private Sub PrintPic(ByVal sPicFile As String)
    
50.     Dim oPicture As Object, nTop As Double, nLeft As Double
    
51.    
    
52.     With ActiveSheet
    
53.         nTop = .[A1].Top
    
54.         nLeft = .[A1].Left
    
55.         For Each oPicture In .Shapes
    
56.             If oPicture.Name <> "CommandButton1" Then oPicture.Delete
    
57.         Next oPicture
    
58.         Set oPicture = .Pictures.Insert(sPicFile)
    
59.         With oPicture
    
60.             .Name = "Invoice_IMG"
    
61.             .Top = nTop
    
62.             .Left = nLeft
    
63.         End With
    
64.         .PrintOut
    
65.         oPicture.Delete
    
66.     End With
    
67. End Sub

复制代码

ageovb

需要安装Acrobat么？这个是两张发票打印在一张A4纸上？

dzsrmyh

ageovb 发表于 2020-1-14 22:28
需要安装Acrobat么？这个是两张发票打印在一张A4纸上？

非常好用，但因为装订的原因，可否将打印位置尽量向右靠呢？谢谢！

microyip

dzsrmyh 发表于 2020-8-1 10:59
非常好用，但因为装订的原因，可否将打印位置尽量向右靠呢？谢谢！

你可以把A列作为调整位置的地方，图片放在B列位置，就能实现你要的效果

dzsrmyh

microyip 发表于 2020-8-1 11:08
你可以把A列作为调整位置的地方，图片放在B列位置，就能实现你要的效果

谢谢了，我试试看

dzsrmyh

您好，我将图片放在B列位置可以达到我想要的效果了，可每张发票都多打了一张空白页，这个应该怎么解决呢？

dzsrmyh

您好，我将图片放在B列位置，可以达到我想要的效果，可每张发票都多打了一张空白页，这个应该怎么解决呢？

microyip

dzsrmyh 发表于 2020-8-3 10:57
您好，我将图片放在B列位置，可以达到我想要的效果，可每张发票都多打了一张空白页，这个应该怎么解决呢？

适当把图片比例缩小一点点

mafect

感谢分享~~

wizardwolf

额。。。为什么不能合并PDF文件，打印的时候选择一张纸上打印多个文件呢。。。