EXCELvba 封装函数之PDF文件导出各种格式

bluesky_0

文档性质的PDF,可以导出很多格式,我导出使用的格式 是 图片,EXCEL,其他格式没有用过;
在Win10  Adobe9.0 pro, Adobe DC pro 运行OK
注意生成的EXCEL格式文件,需要Adobe PRO 10.0 以上版本

1. Public Function SavePDFAsFormat(PDFPath_old As String, pdfName As String, PDFPath_new As String, FileExtension As String, Optional fileName As String = "") As String
   
2.     'PDFPath_old As String, PDFname As String, 分别是PDF文件地址,文件名;分别举例:D:\OK,test.pdf
   
3.     'PDFPath_new As String, FileExtension As String, Optional file_name As String = "" 分别是新地址,格式,可选项文件名,默认是原PDF文件名
   
4.     '重名不覆盖,自动重命名-001
   
5.     Dim objAcroApp      As Acrobat.acroApp
   
6.     Dim objAcroAVDoc    As Acrobat.acroAVDoc
   
7.     Dim objAcroPDDoc    As Acrobat.acroPDDoc
   
8.     Dim objJSO          As Object
   
9.     Dim boResult        As Boolean
   
10.     Dim ExportFormat    As String
    
11.     Dim NewFilePath     As String
    
12.       
    
13.     'Initialize Acrobat by creating App object.
    
14.     Set objAcroApp = CreateObject("AcroExch.App")
    
15.    
    
16.     'Set AVDoc object.
    
17.     Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")
    
18.    
    
19.     'Open the PDF file.
    
20. '    boResult = objAcroAVDoc.Open(PDFPath_old & "" & pdfName & ".pdf", "")
    
21.     boResult = objAcroAVDoc.Open(PDFPath_old & "" & pdfName, "")
    
22.       
    
23.     'Set the PDDoc object.
    
24.     Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
    
25.    
    
26.     'Set the JS Object - JavaScript Object.
    
27.     Set objJSO = objAcroPDDoc.GetJSObject
    
28.    
    
29.     'Check the type of conversion.
    
30.     Select Case LCase(FileExtension)
    
31.         Case "eps": ExportFormat = "com.adobe.acrobat.eps"
    
32.         Case "html", "htm": ExportFormat = "com.adobe.acrobat.html"
    
33.         Case "jpeg", "jpg", "jpe": ExportFormat = "com.adobe.acrobat.jpeg"
    
34.         Case "jpf", "jpx", "jp2", "j2k", "j2c", "jpc": ExportFormat = "com.adobe.acrobat.jp2k"
    
35.         Case "docx": ExportFormat = "com.adobe.acrobat.docx"
    
36.         Case "doc": ExportFormat = "com.adobe.acrobat.doc"
    
37.         Case "png": ExportFormat = "com.adobe.acrobat.png"
    
38.         Case "ps": ExportFormat = "com.adobe.acrobat.ps"
    
39.         Case "rft": ExportFormat = "com.adobe.acrobat.rft"
    
40.         Case "xlsx": ExportFormat = "com.adobe.acrobat.xlsx"
    
41.         Case "xls": ExportFormat = "com.adobe.acrobat.spreadsheet"
    
42.         Case "txt": ExportFormat = "com.adobe.acrobat.accesstext"
    
43.         Case "tiff", "tif": ExportFormat = "com.adobe.acrobat.tiff"
    
44.         Case "xml": ExportFormat = "com.adobe.acrobat.xml-1-00"
    
45.         Case Else: ExportFormat = "Wrong Input"
    
46.     End Select
    
47.    
    
48.     'Check if the format is correct and there are no errors.
    
49.     If ExportFormat <> "Wrong Input" And Err.Number = 0 Then
    
50.       
    
51.         'Format is correct and no errors.
    
52.       
    
53.         'Set the path of the new file.
    
54.         If fileName = "" Then
    
55.             fileName = pdfName
    
56.         End If
    
57.         
    
58.         counter = 1
    
59.         Do While Dir(PDFPath_new & "" & fileName & "-" & Format(counter, "000") & "." & FileExtension) <> ""
    
60.             counter = counter + 1
    
61.         Loop
    
62.         
    
63.         If LCase(FileExtension) <> "xls" Then
    
64.             NewFilePath = PDFPath_new & "" & fileName & "-" & Format(counter, "000") & "." & FileExtension
    
65.         Else
    
66.             NewFilePath = PDFPath_new & "" & fileName & "-" & Format(counter, "000") & ".xml"
    
67.         End If
    
68.       
    
69.         'Save PDF file to the new format.
    
70.         boResult = objJSO.SaveAs(NewFilePath, ExportFormat)
    
71.       
    
72.         'Close the PDF file without saving the changes.
    
73.         boResult = objAcroAVDoc.Close(True)
    
74.       
    
75.         'Close the Acrobat application.
    
76.         boResult = objAcroApp.Exit
    
77.       
    
78.     Else
    
79.       
    
80.         'Something went wrong, so close the PDF file and the application.
    
81.       
    
82.         'Close the PDF file without saving the changes.
    
83.         boResult = objAcroAVDoc.Close(True)
    
84.       
    
85.         'Close the Acrobat application.
    
86.         boResult = objAcroApp.Exit
    
87. 
    
88.     End If
    
89.     SavePDFAsFormat = NewFilePath
    
90.     'Release the objects.
    
91.     Set objAcroPDDoc = Nothing
    
92.     Set objAcroAVDoc = Nothing
    
93.     Set objAcroApp = Nothing
    
94. End Function
    

复制代码

shiruiqiang

感谢分享，学习一下

沈默00

支持分享，学习了

QQ214189912

Adobe Acrobat 报错 无法写入指定的文件。该文件可能正在使用。

bluesky_0

QQ214189912 发表于 2024-4-10 20:35
Adobe Acrobat 报错 无法写入指定的文件。该文件可能正在使用。

EXCELvba 文件发来看看,我没有遇到你说的 问题
我是这样子调用的

ActiveSheet.Range("AJ" & i) = SavePDFAsFormat(sourceFolderPath, fileName, destinationFolderPath, "xlsx", newFileName)

opiona

支持分享, 操作PDF

rendiule01

我的office  2016 32位，大佬，我用access VBA  在窗体上把报表转PDF，里面的图片logo 转换成功后，丢失啦！


直接打开报表 图片控件会显示图片mylogo.png，而在窗体放置一个打印按钮：打开rpt_JY_MF报表， JY_no='" & Me![JY_NO] & "'"却不显示图片？
下面是打印按钮的VBA代码
Private Sub btnPrint_Click()
    DoCmd.OpenReport "rptJY_MF", acViewPreview, , "JY_no='" & Me![JY_NO] & "'"
End Sub

管理系统.zip (217.86 KB, 下载次数: 4)

2024-4-11 08:20 上传

点击文件名下载附件

bluesky_0

rendiule01 发表于 2024-4-11 08:20
我的office  2016 32位，大佬，我用access VBA  在窗体上把报表转PDF，里面的图片logo 转换成功后，丢失啦 ...

你这个,我看看能不能搞定