PDF插件 for VBA 合并,提取,旋转等

jy03342543

这是个好东西果断收藏 感谢大神分享

gc6699

求助这个 请老师帮忙看下怎么优化呀 感谢啦！https://club.excelhome.net/thread-1657271-1-1.html

aman1516

opiona 发表于 2023-3-19 20:52
控件 本身不支持形状的导出
据说最新版 9.2.6  可以导出表格  但是我没有破解版

能否来个一键转PPT的
现在AI热的很，WORD都一键生成PPT了

opiona

aman1516 发表于 2023-3-21 13:40
能否来个一键转PPT的
现在AI热的很，WORD都一键生成PPT了

现有的插件版本 4.8.8 和谐版 不支持

新版本的和谐版  还未找到

opiona

vba 导出PDF的文本   不需要DLL
但是不支持扫描件的识别, 只支持Excel,Word另存为的PDF文件
(DLL内函数可以识别扫描件)
要求安装专业版 引用：Adobe Acrobat 10.0 Type Library  （版本可能不一样 专业版即可）

1. Sub TEST()
   
2.     Path = ThisWorkbook.Path & "\葛覃.pdf"
   
3.     PATHTEXT = ThisWorkbook.Path & "\Temp.TXT"
   
4.     MsgBox PDF2TXT(Path, PATHTEXT)
   
5. End Sub
   
6. 
   
7. Rem 将可编辑PDF转为：文本文件==============================================================
   
8. Rem 参数：strPdfFile    Pdf文件全路径
   
9. Rem 参数：strTXTFile    文本文件全路径
   
10. Rem 输出：Boolean       打不开，或者中途出错，输出：False
    
11. Public Function PDF2TXT(ByVal strPdfFile As String, ByVal strTXTFile As String) As Boolean
    
12.     Application.ScreenUpdating = False
    
13.     Err.Clear
    
14.    
    
15.     Dim app As Acrobat.AcroApp
    
16.     Dim jso As Object
    
17.     Dim avDoc As Acrobat.AcroAVDoc
    
18.     Dim pdDoc As Acrobat.AcroPDDoc
    
19.     Set app = CreateObject("AcroExch.App")          '//定义：Adobe  要求安装专业版 引用：Adobe Acrobat 10.0 Type Library  （版本可能不一样）
    
20.     Set avDoc = CreateObject("AcroExch.AVDoc")      '//定义：一个打开的PDF文件
    
21.    
    
22.     Rem '//打开制定的PDF文件
    
23.     If Not avDoc.Open(strPdfFile, "文档转换") Then
    
24.         '        MsgBox "不能打开指定的 " & strPdfFile & " 文档！", vbOKOnly + vbCritical, "系统信息"
    
25.         Set avDoc = Nothing
    
26.         Set app = Nothing
    
27.         Application.ScreenUpdating = True
    
28.         PDF2TXT = False
    
29.         Exit Function
    
30.     End If
    
31.    
    
32.     Rem 先删除文本文件
    
33.     Dim FSO
    
34.     Set FSO = CreateObject("Scripting.FileSystemObject")
    
35.     If FSO.FolderExists(strTXTFile) = True Then
    
36.         Kill strTXTFile
    
37.     End If
    
38.    
    
39.    
    
40.     Set pdDoc = avDoc.GetPDDoc()
    
41.     Set jso = pdDoc.GetJSObject
    
42.     On Error Resume Next
    
43.     jso.SaveAs strTXTFile, "com.adobe.acrobat.plain-text"
    
44.     app.CloseAllDocs
    
45.     app.Exit
    
46.     Set jso = Nothing
    
47.     Set pdDoc = Nothing
    
48.     Set avDoc = Nothing
    
49.     Set app = Nothing
    
50.    
    
51.     Application.ScreenUpdating = True
    
52.    
    
53.     If Err.Number <> 0 Then
    
54.         PDF2TXT = False
    
55.     Else
    
56.         PDF2TXT = True
    
57.     End If
    
58.    
    
59. End Function
    

复制代码

opiona

opiona

添加PDF动态图章

opiona

双面打印多个PDF文件
VBA套用多个DLL函数来实现

这段代码应该是有Bug: 页码顺序,如果总数是奇数 可能会串页  没有打印机没有测试
实际最好是将这些PDF合并成一个,然后打印机双面打印

1. 
   
2. Sub TEST_双面打印()
   
3.     Dim ARX
   
4.     Dim StrPrintName, PathXPS, PassWord, ZCM As String
   
5.    
   
6.     StrPrintName = ""
   
7.     PathXPS = ""
   
8.     PassWord = ""
   
9.     ZCM = "QQ14885553"
   
10.    
    
11.     ReDim ARX(0 To 3)
    
12.     ARX(0) = ThisWorkbook.Path & "\PDF\A14.PDF"
    
13.     ARX(1) = ThisWorkbook.Path & "\PDF\A1.PDF"
    
14.     ARX(2) = ThisWorkbook.Path & "\PDF\A2.PDF"
    
15.     ARX(3) = ThisWorkbook.Path & "\PDF\A3.PDF"
    
16.    
    
17.     Call GA_双面打印多个PDF文件(ARX, StrPrintName:=StrPrintName, PathXPS:=PathXPS, PassWord:=PassWord, ZCM:=ZCM)
    
18.    
    
19.     MsgBox "双面打印完成", vbInformation, "北极狐工作室QQ: 14885553"
    
20.    
    
21. End Sub
    
22. 
    
23. Sub GA_双面打印多个PDF文件(ByVal ARX, Optional ByVal StrPrintName As String = "", Optional ByVal PathXPS As String = "", Optional ByVal PassWord As String = "", Optional ByVal ZCM As String = "")
    
24.     Rem ARX                    数组  需要打印的PDF文件全路径
    
25.     Rem StrPrintName      打印机名称 默认="" 默认打印机
    
26.     Rem PathXPS             打印机名="Microsoft XPS Document Writer" 需要指定保存文件的路径
    
27.     Rem PassWord           PDF文件密码 默认="" 没有密码
    
28.     Rem ZCM                   注册码
    
29.     Rem 使用方法             Call GA_双面打印多个PDF文件(ARX, StrPrintName:=StrPrintName, PathXPS:=PathXPS, PassWord:=PassWord, ZCM:=ZCM)
    
30.    
    
31.     Dim PDFDLL As Object
    
32.     Dim ERX, ZAC, ZAD
    
33.     Dim I, X, LB, INTX, IntPages As Long
    
34.     Dim StrPages As String
    
35.     Dim BL As Boolean
    
36.    
    
37.     Rem 创建函数类对象 CreateObject  不需要提前引用
    
38.     Set PDFDLL = CreateObject("GTDPDFPlugIn.PDFClass")    'DLL文件内Class的名称 现在如无意外，就可以创建一个MyDLLClass对象，YEAH！
    
39.    
    
40.     Rem 获取全部页面 正面反面
    
41.     Set ZAC = CreateObject("Scripting.Dictionary")
    
42.     Set ZAD = CreateObject("Scripting.Dictionary")
    
43.     INTX = 0
    
44.     LB = LBound(ARX)
    
45.     For X = LB + 0 To UBound(ARX)
    
46.         IntPages = PDFDLL.GetNumPagesPDF(PathPDF:=ARX(X), PassWord:=PassWord, ZCM:=ZCM)
    
47.         For I = 1 To IntPages
    
48.             INTX = INTX + 1
    
49.             If INTX Mod 2 = 1 Then
    
50.                 If ZAC.EXISTS(ARX(X)) = False Then
    
51.                     ZAC(ARX(X)) = I
    
52.                 Else
    
53.                     ZAC(ARX(X)) = ZAC(ARX(X)) & "," & I
    
54.                 End If
    
55.             Else
    
56.                 If ZAD.EXISTS(ARX(X)) = False Then
    
57.                     ZAD(ARX(X)) = I
    
58.                 Else
    
59.                     ZAD(ARX(X)) = ZAD(ARX(X)) & "," & I
    
60.                 End If
    
61.             End If
    
62.         Next
    
63.     Next
    
64.     Rem  打印单数页
    
65.     ERX = ZAC.KEYS
    
66.     For X = 0 To UBound(ERX)
    
67.         StrPages = ZAC(ERX(X))
    
68.         INTX = PDFDLL.PrintPagesPDF(PathPDF:=ERX(X), StrPages:=StrPages, StrPrintName:=StrPrintName, PathXPS:=PathXPS, PassWord:=PassWord, ZCM:=ZCM)
    
69.     Next
    
70.    
    
71.     Rem  打印双数页
    
72.     BL = False
    
73.     If MsgBox("所选PDF单数页 打印完成" & vbCrLf & "请将纸张翻转  准备打印双数页" & vbCrLf & vbCrLf & "请确认: 已准备好, 开始打印双数页?", vbInformation + vbDefaultButton2 + vbYesNo, "北极狐工作室QQ: 14885553") = vbYes Then
    
74.         BL = True
    
75.     Else
    
76.         If MsgBox("确认不需要打印 双数页 吗?" & vbCrLf & vbCrLf & "不打印 点击: 是   打印 点击: 否", vbInformation + vbDefaultButton2 + vbYesNo, "北极狐工作室QQ: 14885553") = vbNo Then
    
77.              BL = True
    
78.         End If
    
79.     End If
    
80.    
    
81.     If BL = True Then
    
82.         ERX = ZAD.KEYS
    
83.         For X = 0 To UBound(ERX)
    
84.             StrPages = ZAD(ERX(X))
    
85.             INTX = PDFDLL.PrintPagesPDF(PathPDF:=ERX(X), StrPages:=StrPages, StrPrintName:=StrPrintName, PathXPS:=PathXPS, PassWord:=PassWord, ZCM:=ZCM)
    
86.         Next
    
87.     End If
    
88.    
    
89.     Rem 释放对象
    
90.     Set PDFDLL = Nothing
    
91.    
    
92. End Sub
    
93. 
    

复制代码

perfect131

opiona 发表于 2023-3-31 13:47
添加PDF动态图章

找到一个  Spire.Office v6.10.3 已经测试 Spire.Pdf.dll 激活就可以用(没有 10页限制)

幼稚园儿童

我想问一下，更新的功能是不是要把旧注册的删了重新注册才可以