PDF export from Excel

joforn

是这样的么？

原文件中的代码好像在Win7中没有什么反应，所以全部修改了。

范德萨

joforn 发表于 2015-10-15 13:50
是这样的么？

原文件中的代码好像在Win7中没有什么反应，所以全部修改了。

请教joforn版主，由于水平太有限了，很多东西都看不懂，但最想知道的是，那个pdf文件的内容是怎么生成的，比较好奇点，谢谢。

joforn

范德萨 发表于 2015-10-15 14:03
请教joforn版主，由于水平太有限了，很多东西都看不懂，但最想知道的是，那个pdf文件的内容是怎么生成的 ...

直接从xls文件中读取出来的。

范德萨

joforn 发表于 2015-10-15 14:04
直接从xls文件中读取出来的。

谢谢指点，明白了。就是表中的那个pdf（像是图片一样的那个）文件。
joforn版主，那个文件有点神奇，我先解剖去。作品看来需要时间去消化了，谢谢。

lfspecter

joforn 发表于 2015-10-15 13:50
是这样的么？

原文件中的代码好像在Win7中没有什么反应，所以全部修改了。

多谢版主，第一次测试成功，之后就没有反应了，而且我有三个PDF文档，只是导出了一个。

joforn

lfspecter 发表于 2015-10-15 14:43
多谢版主，第一次测试成功，之后就没有反应了，而且我有三个PDF文档，只是导出了一个。

如果方便的话，把你的文件发到版主群，我用的你文件调试下。看下问题在哪。

lfspecter

joforn 发表于 2015-10-15 19:22
如果方便的话，把你的文件发到版主群，我用的你文件调试下。看下问题在哪。

谢谢，不好意思，这个因为资料保密，不方便上传。

t13564865256

liucqa好好笑，发个知识数，在发表一句每年都有人找这个问题。
解决又解决不了。
我估计你连版主发的帖子要求是什么都不知道。

joforn

lfspecter 发表于 2015-10-16 10:19
谢谢，不好意思，这个因为资料保密，不方便上传。

你把这个代码覆盖掉ClsLaolaFile类中的同名过程，然后再运行测试。原来代码多了几层判断，可能你的有些文件不通过，被过滤掉了。还有就是，提取前要保证文件已经存过盘，如果插入对象后没有存盘的话，只能提取存盘前的文件：

1. 
   
2. Public Sub SaveAllOLEFile(ByVal strPath As String, Optional ByVal strFileName As String, Optional ByVal Extension As String, _
   
3.                            Optional ByVal StartNumber As Long = 1, _
   
4.                            Optional ByRef CheckFileHand As Variant = Null)
   
5.   Dim blnCheck      As Boolean
   
6.   Dim Length        As Long
   
7.   Dim bytFile()     As Byte
   
8.   Dim bytCheck()    As Byte
   
9.   Dim lenCheck      As Long
   
10.   Dim I As Long, J  As Long, K As Long, L As Long
    
11.   Dim FileName      As String
    
12.   
    
13.   On Error Resume Next
    
14.   blnCheck = Not IsNull(CheckFileHand)
    
15.   blnCheck = blnCheck And Not (IsEmpty(CheckFileHand))
    
16.   
    
17.   
    
18.   strPath = PathAddBackslash(strPath)
    
19.   If StartNumber < 0 Then StartNumber = 1
    
20.   If Not MKDirctory(strPath) Then
    
21.     MsgBox "创建目录失败！请确认你的目录名是否设置错误！", vbCritical
    
22.     Exit Sub
    
23.   End If
    
24.   
    
25.   If blnCheck Then
    
26.     Select Case VarType(CheckFileHand)
    
27.       Case vbString:  bytCheck = CheckFileHand: lenCheck = UBound(bytCheck) - LBound(bytCheck) + 1
    
28.       Case vbArray Or vbByte
    
29.         J = LBound(CheckFileHand)
    
30.         I = UBound(CheckFileHand)
    
31.         lenCheck = I - J + 1
    
32.         ReDim bytCheck(0 To I - J)
    
33.         For I = 0 To UBound(bytCheck)
    
34.           bytCheck(I) = CheckFileHand(I + J)
    
35.         Next I
    
36.       Case vbInteger
    
37.         lenCheck = 2
    
38.         ReDim bytCheck(0 To 1)
    
39.         bytCheck(0) = CInt(CheckFileHand) And &HFF&
    
40.         bytCheck(1) = CInt(CheckFileHand) \ &H100&
    
41.       Case vbLong
    
42.         lenCheck = 4
    
43.         ReDim bytCheck(0 To lenCheck - 1)
    
44.         I = CheckFileHand
    
45.         CopyMemory bytCheck(0), I, lenCheck
    
46.       Case Else: blnCheck = False
    
47.     End Select
    
48.   End If
    
49.   
    
50.   For I = 0 To UBound(Directory)
    
51.     With Directory(I)
    
52.       If (.Length > 0) And (.DirType = UserStream) Then
    
53.         K = 0
    
54.         If lenCheck > 0 Then
    
55.           If ReadStream(I, bytFile, lenCheck) Then
    
56.             For L = 0 To lenCheck - 1
    
57.               K = K Or (bytFile(L) Xor bytCheck(L))
    
58.             Next L
    
59.           End If
    
60.         End If
    
61.         
    
62.         If K = 0 Then
    
63.           If ReadStream(I, bytFile, .Length) Then
    
64.             Do
    
65.               FileName = PathRenameExtension(strPath & strFileName & StartNumber, Extension)
    
66.               StartNumber = StartNumber + 1
    
67.             Loop While FileExists(FileName)
    
68.             K = FreeFile
    
69.             Open FileName For Binary As K
    
70.             Put K, , bytFile()
    
71.             Close K
    
72.           End If
    
73.         End If
    
74.       End If
    
75.     End With
    
76.   Next I
    
77. End Sub
    

复制代码

joforn

lfspecter 发表于 2015-10-16 10:19
谢谢，不好意思，这个因为资料保密，不方便上传。

新上传的文件已经使用你的文件测试OK