PDF export from Excel

lfspecter

PDF Export from Excel 2.0.xls.zip (1.36 MB, 下载次数: 67)

2015-10-14 13:29 上传

点击文件名下载附件

以下代码是08年的时候 stanleypan版主帮忙写的，目的是在一个Excel文件中把PDF文档导出另存。
现在版本升级了，请帮忙看看如果在07中正常使用。

1. Option Explicit
   
2. Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
   
3. Public Const VK_CONTROL = &H11
   
4. Public Const VK_V = &H56
   
5. Public Const VK_LEFT = &H25
   
6. Public Const KEYEVENTF_EXTENDEDKEY = &H1
   
7. Public Const KEYEVENTF_KEYUP = &H2
   
8. Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
   
9. Const Vital = "Sheet1"
   
10. Public iret As Long
    
11. Public curWindow As Long
    
12. Sub LoopSheet()
    
13. Dim sPath As String, sPathDest As String
    
14.     Sheets(Vital).Activate
    
15.     Application.ScreenUpdating = False
    
16.     Dim myobject As Object
    
17.     On Error Resume Next
    
18.     For Each myobject In Sheets(Vital).Shapes
    
19.         Debug.Print Sheets(Vital).Shapes.Count
    
20.         Debug.Print myobject.Name
    
21.         Debug.Print myobject.Type    'msoEmbeddedOLEObject=7
    
22.         Debug.Print myobject.OLEFormat.progID    ' "AcroExch.Document.7"
    
23.         'Debug.Print myobject.OLEFormat.Object.SourceName
    
24.         ' : Type : msoAutoShape : MsoShapeType : ModExportPDF.LoopSheet
    
25.         If myobject.Type <> msoEmbeddedOLEObject Then Exit For
    
26. 
    
27.         sPath = Application.ThisWorkbook.Path
    
28.         sPathDest = sPath & "" & "PDF"
    
29.         ' On Error Resume Next
    
30.         If FolderExists(sPathDest) = True Then
    
31.         Else
    
32.             Call MkDir(sPathDest)
    
33.         End If
    
34.         sPathDest = sPathDest & ""
    
35.         '--Copy 出来了---如何导出必须用到更高深的API了.
    
36.         ShellExecute 0, "open", sPathDest, "", sPathDest, 1
    
37. 
    
38.         ActiveSheet.Shapes(myobject.Name).Select
    
39.         myobject.Copy
    
40.         'using API keybd event
    
41.         keybd_event VK_CONTROL, 0, 0, 0
    
42.         keybd_event VK_V, 0, 0, 0    ' press Ctrl-V - Paste keys
    
43.         DoEvents
    
44.         keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0    'Release
    
45.         keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0    'Release
    
46.         DoEvents
    
47.         Dim Start As Long
    
48.         'slow things down
    
49.         Start = Timer + 1.2
    
50.         While Start > Timer
    
51.             DoEvents
    
52.         Wend
    
53. 
    
54.     Next
    
55.     On Error GoTo 0
    
56.     Application.ScreenUpdating = True
    
57.     'Exit Sub
    
58. End Sub
    
59. Public Function FolderExists(ByVal Path As String, Optional ByVal Att As VbFileAttribute = -1) As Boolean
    
60.     On Error Resume Next
    
61.     If Att = -1 Then
    
62.         FolderExists = VBA.GetAttr(Path)
    
63.     Else
    
64.         FolderExists = VBA.GetAttr(Path) And Att
    
65.     End If
    
66. End Function
    

复制代码

huang1314wei

版主，你们研究的东西，哪是我们这些小喽喽能懂的

t13564865256

huang1314wei 发表于 2015-10-13 17:20
版主，你们研究的东西，哪是我们这些小喽喽能懂的

我懂了，我就不回答

Zamyi

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\1.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

t13564865256

Zamyi 发表于 2015-10-13 17:30
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\1.pdf", Quality:=xlQualityStandard, I ...

你这个和他要的好像不是一回事。

lfspecter

Zamyi 发表于 2015-10-13 17:30
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\1.pdf", Quality:=xlQualityStandard, I ...

这个文件的目的是在一个Excel文件中将N个PDF文档另存到指定的目录下

feiren228

学习，关注，还不懂API

joforn

你运行时有没有错误提示？

lfspecter

joforn 发表于 2015-10-13 22:17
你运行时有没有错误提示？

没有任何提示。

范德萨

斑竹找到了一个网页不知道里面说的是什么，希望斑竹早日完工，能分享下成品
https://ukproxy.vpnbook.com/brow ... OYeuwElc%3D&b=0