[推荐]老外的+我的改進=直接生成完美的PDF報表

chajiangliang

老外的好東東

http://www.lebans.comeporttopdf.htm

我的改進:



Public Function ConvertReportToPDF( _
Optional RptName As String = "", _
Optional SnapshotName As String = "", _
Optional OutputPDFname As String = "", _
Optional ShowSaveFileDialog As Boolean = False, _
Optional StartPDFViewer As Boolean = True, _
Optional CompressionLevel As Long = 0, _
Optional PasswordOwner As String = "", _
Optional PasswordOpen As String = "", _
Optional PasswordRestrictions As Long = 0, _
Optional PDFNoFontEmbedding As Long = 0, Optional Wherecon As String) As Boolean


' RptName is the name of a report contained within this MDB
' SnapshotName is the name of an existing Snapshot file
' OutputPDFname is the name you select for the output PDF file
' ShowSaveFileDialog is a boolean param to specify whether or not to display
' the standard windows File Dialog window to select an exisiting Snapshot file
' CompressionLevel - not hooked up yet
' PasswordOwner  - not hooked up yet
' PasswordOpen - not hooked up yet
' PasswordRestrictions - not hooked up yet
' PDFNoFontEmbedding - Do not Embed fonts in PDF. Set to 1 to stop the
' default process of embedding all fonts in the output PDF. If you are
' using ONLY - any of the standard Windows fonts
' using ONLY - any of the standard 14 Fonts natively supported by the PDF spec
'The 14 Standard Fonts
'All version of Adobe's Acrobat support 14 standard fonts. These fonts are always available
'independent whether they're embedded or not.
'Family name PostScript name Style
'Courier Courier fsNone
'Courier Courier-Bold fsBold
'Courier Courier-Oblique fsItalic
'Courier Courier-BoldOblique fsBold + fsItalic
'Helvetica Helvetica fsNone
'Helvetica Helvetica-Bold fsBold
'Helvetica Helvetica-Oblique fsItalic
'Helvetica Helvetica-BoldOblique fsBold + fsItalic
'Times Times-Roman fsNone
'Times Times-Bold fsBold
'Times Times-Italic fsItalic
'Times Times-BoldItalic fsBold + fsItalic
'Symbol Symbol fsNone, other styles are emulated only
'ZapfDingbats ZapfDingbats fsNone, other styles are emulated only


Dim s As String
Dim blRet As Boolean
' Let's see if the DynaPDF.DLL is available.
blRet = LoadLib()
If blRet = False Then
    ' Cannot find DynaPDF.dll or StrStorage.dll file
    Exit Function
End If

On Error GoTo ERR_CREATSNAP

Dim strPath  As String
Dim strPathandFileName  As String
Dim strEMFUncompressed As String

Dim sOutFile As String
Dim lngRet As Long

' Init our string buffer
strPath = Space(Pathlen)

'Save the ReportName to a local var
mReportName = RptName

' Let's kill any existing Temp SnapShot file
If Len(mUncompressedSnapFile & vbNullString) > 0 Then
    Kill mUncompressedSnapFile
    mUncompressedSnapFile = ""
End If

' If we have been passed the name of a Snapshot file then
' skip the Snapshot creation process below
If Len(SnapshotName & vbNullString) = 0 Then
      
    ' Make sure we were passed a ReportName
    If Len(RptName & vbNullString) = 0 Then
        ' No valid parameters - FAIL AND EXIT!!
        ConvertReportToPDF = ""
        Exit Function
    End If
        
    ' Get the Systems Temp path
    ' Returns Length of path(num characters in path)
    lngRet = GetTempPath(Pathlen, strPath)
    ' Chop off NULLS and trailing "\"
    strPath = Left(strPath, lngRet) & Chr(0)
   
    ' Now need a unique Filename
    ' locked from a previous aborted attemp.
    ' Needs more work!
    strPathandFileName = GetUniqueFilename(strPath, "SNP" & Chr(0), "snp")
   
    ' Export the selected Report to SnapShot format
<FONT color=#f73809>   DoCmd.Echo False
    DoCmd.OpenReport RptName, acViewPreview, , Wherecon
    Reports(RptName).Visible = False
  

fan0217

1. Public Function ConvertReportToPDF( _
   
   
2. Optional RptName As String = "", _
   
   
3. Optional SnapshotName As String = "", _
   
   
4. Optional OutputPDFname As String = "", _
   
   
5. Optional ShowSaveFileDialog As Boolean = False, _
   
   
6. Optional StartPDFViewer As Boolean = True, _
   
   
7. Optional CompressionLevel As Long = 0, _
   
   
8. Optional PasswordOwner As String = "", _
   
   
9. Optional PasswordOpen As String = "", _
   
   
10. Optional PasswordRestrictions As Long = 0, _
    
    
11. Optional PDFNoFontEmbedding As Long = 0, Optional Wherecon As String) As Boolean
    
    
12. 
    
    
13. 
    
    
14. ' RptName is the name of a report contained within this MDB
    
    
15. ' SnapshotName is the name of an existing Snapshot file
    
    
16. ' OutputPDFname is the name you select for the output PDF file
    
    
17. ' ShowSaveFileDialog is a boolean param to specify whether or not to display
    
    
18. ' the standard windows File Dialog window to select an exisiting Snapshot file
    
    
19. ' CompressionLevel - not hooked up yet
    
    
20. ' PasswordOwner - not hooked up yet
    
    
21. ' PasswordOpen - not hooked up yet
    
    
22. ' PasswordRestrictions - not hooked up yet
    
    
23. ' PDFNoFontEmbedding - Do not Embed fonts in PDF. Set to 1 to stop the
    
    
24. ' default process of embedding all fonts in the output PDF. If you are
    
    
25. ' using ONLY - any of the standard Windows fonts
    
    
26. ' using ONLY - any of the standard 14 Fonts natively supported by the PDF spec
    
    
27. 'The 14 Standard Fonts
    
    
28. 'All version of Adobe's Acrobat support 14 standard fonts. These fonts are always available
    
    
29. 'independent whether they're embedded or not.
    
    
30. 'Family name PostScript name Style
    
    
31. 'Courier Courier fsNone
    
    
32. 'Courier Courier-Bold fsBold
    
    
33. 'Courier Courier-Oblique fsItalic
    
    
34. 'Courier Courier-BoldOblique fsBold + fsItalic
    
    
35. 'Helvetica Helvetica fsNone
    
    
36. 'Helvetica Helvetica-Bold fsBold
    
    
37. 'Helvetica Helvetica-Oblique fsItalic
    
    
38. 'Helvetica Helvetica-BoldOblique fsBold + fsItalic
    
    
39. 'Times Times-Roman fsNone
    
    
40. 'Times Times-Bold fsBold
    
    
41. 'Times Times-Italic fsItalic
    
    
42. 'Times Times-BoldItalic fsBold + fsItalic
    
    
43. 'Symbol Symbol fsNone, other styles are emulated only
    
    
44. 'ZapfDingbats ZapfDingbats fsNone, other styles are emulated only
    
    
45. 
    
    
46. 
    
    
47. Dim s As String
    
    
48. Dim blRet As Boolean
    
    
49. ' Let's see if the DynaPDF.DLL is available.
    
    
50. blRet = LoadLib()
    
    
51. If blRet = False Then
    
    
52. ' Cannot find DynaPDF.dll or StrStorage.dll file
    
    
53. Exit Function
    
    
54. End If
    
    
55. 
    
    
56. On Error GoTo ERR_CREATSNAP
    
    
57. 
    
    
58. Dim strPath As String
    
    
59. Dim strPathandFileName As String
    
    
60. Dim strEMFUncompressed As String
    
    
61. 
    
    
62. Dim sOutFile As String
    
    
63. Dim lngRet As Long
    
    
64. 
    
    
65. ' Init our string buffer
    
    
66. strPath = Space(Pathlen)
    
    
67. 
    
    
68. 'Save the ReportName to a local var
    
    
69. mReportName = RptName
    
    
70. 
    
    
71. ' Let's kill any existing Temp SnapShot file
    
    
72. If Len(mUncompressedSnapFile & vbNullString) > 0 Then
    
    
73. Kill mUncompressedSnapFile
    
    
74. mUncompressedSnapFile = ""
    
    
75. End If
    
    
76. 
    
    
77. ' If we have been passed the name of a Snapshot file then
    
    
78. ' skip the Snapshot creation process below
    
    
79. If Len(SnapshotName & vbNullString) = 0 Then
    
    
80. 
    
    
81. ' Make sure we were passed a ReportName
    
    
82. If Len(RptName & vbNullString) = 0 Then
    
    
83. ' No valid parameters - FAIL AND EXIT!!
    
    
84. ConvertReportToPDF = ""
    
    
85. Exit Function
    
    
86. End If
    
    
87. 
    
    
88. ' Get the Systems Temp path
    
    
89. ' Returns Length of path(num characters in path)
    
    
90. lngRet = GetTempPath(Pathlen, strPath)
    
    
91. ' Chop off NULLS and trailing ""
    
    
92. strPath = Left(strPath, lngRet) & Chr(0)
    
    
93. 
    
    
94. ' Now need a unique Filename
    
    
95. ' locked from a previous aborted attemp.
    
    
96. ' Needs more work!
    
    
97. strPathandFileName = GetUniqueFilename(strPath, "SNP" & Chr(0), "snp")
    
    
98. 
    
    
99. ' Export the selected Report to SnapShot format
    
    
100. DoCmd.Echo False
     
     
101. DoCmd.OpenReport RptName, acViewPreview, , Wherecon
     
     
102. Reports(RptName).Visible = False

复制代码

先睹为快!

tmtony

leban的东东都是精品,我也在用这个工具哦. 谢谢改进与分享.拿来就用了

shala

see

kevindeng

看看

LucasLynn

能否解释下和使用Acrobat Professional效果有何不同？

ey1001

1

Benjamin_luk

梦里寻他千百回,得来全不费功夫.

谢谢分享

liw99814

谢谢

sgrshh29

谢谢分享