I want to generate a PDF file using VBA, I found some tools but I am not sure i开发者_开发百科f it supports to generate in a table format. Or is there another third party tool(free) to generate an access form in PDF format?
Depending on what you want to export and what VBA application you are using you have a few options.
If you are exporting an access report then this is good (and free!) http://www.lebans.com/reporttopdf.htm
For most other things you can use a PDF print driver and push anything you want to export to the “printer”. There are a number of free and commercial options here so google is your friend
Stephen Leban's PDF export library was great for it's era, but that was many years ago, and the library is now not supported at all, which you can see from a quick visit to his web site. Fortunately, you can now use the built-in PDF export capabilities of Access. Here's an example:
DoCmd.OutputTo acOutputReport, "SimpleReport", acFormatPDF, "C:\Users\Paul\Documents\PDFTest01.pdf", False
I believe this works in Access 2007 and up; it definitely works with Access 2013. Here's a link to an MSDN forum post with more information.
Install a PDF print driver and use it to print out your sheet. For example, I have PDFCreator installed.
ActiveSheet.PrintOut ActivePrinter:="PDFCreator"
Warning: PDFCreator is free, but versions 0.9.7 and later come bundled with "tormentware". I have the cleaner version 0.9.6. Of course you can also install some other PDF driver.
The best way for you to create a PDF in Access is to first make the report in access.
The reason being that when you generate the report in Access first, you will have full control on exactly how you want the report to look like in PDF.
Assuming you know how to create reports in Access the following code will help you convert that report into a PDF that then allows the users to save the PDF accordingly.
Dim strReportName = "RptYourReportName" ' first quote in the name of the report you already created in access
Docmd.OpenReport strReportName, acViewPreview 'tell access to open up the report
Reports(strReportName).Visible = False
If Reports(strReportName).HasData then
Call ConverReportToPDF(strReportName,,"Give_Generic_Name.PDF",True,False)
End if
DoCmd.Close acReport, strReportName
Below is the Function that will convert your report - simply copy this into the modules part of your VBA code.
Hope this helps!!
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 PasswordOpen As String = "", _
Optional PasswordOwner As String = "", _
Optional PasswordRestrictions As Long = 0, _
Optional PDFNoFontEmbedding As Long = 0, _
Optional PDFUnicodeFlags As Long = 0 _
) 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 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
DoCmd.OutputTo acOutputReport, RptName, "SnapshotFormat(*.snp)", _
strPathandFileName
' Make sure the process has time to complete
DoEvents
Else
strPathandFileName = SnapshotName
End If
' Let's decompress into same filename but change type to ".tmp"
'strEMFUncompressed = Mid(strPathandFileName, 1, Len(strPathandFileName) - 3)
'strEMFUncompressed = strEMFUncompressed & "tmp"
Dim sPath As String * 512
lngRet = GetTempPath(512, sPath)
strEMFUncompressed = GetUniqueFilename(sPath, "SNP", "tmp")
lngRet = SetupDecompressOrCopyFile(strPathandFileName, strEMFUncompressed, 0&)
If lngRet <> 0 Then
Err.Raise vbObjectError + 525, "ConvertReportToPDF.SetupDecompressOrCopyFile", _
"Sorry...cannot Decompress SnapShot File" & vbCrLf & _
"Please select a different Report to Export"
End If
' Set our uncompressed SnapShot file name var
mUncompressedSnapFile = strEMFUncompressed
' Remember to Cleanup our Temp SnapShot File if we were NOT passed the
' Snapshot file as the optional param
If Len(SnapshotName & vbNullString) = 0 Then
Kill strPathandFileName
End If
' Do we name output file the same as the input file name
' and simply change the file extension to .PDF or
' do we show the File Save Dialog
If ShowSaveFileDialog = False Then
' let's decompress into same filename but change type to ".tmp"
' But first let's see if we were passed an output PDF file name
If Len(OutputPDFName & vbNullString) = 0 Then
sOutFile = Mid(strPathandFileName, 1, Len(strPathandFileName) - 3)
sOutFile = sOutFile & "PDF"
Else
sOutFile = OutputPDFName
End If
Else
' Call File Save Dialog
sOutFile = fFileDialog(OutputPDFName)
If Len(sOutFile & vbNullString) = 0 Then
Exit Function
End If
End If
' Call our function in the StrStorage DLL
' Note the Compression and Password params are not hooked up yet.
blRet = ConvertUncompressedSnapshot(mUncompressedSnapFile, sOutFile, _
CompressionLevel, PasswordOpen, PasswordOwner, PasswordRestrictions, PDFNoFontEmbedding, PDFUnicodeFlags)
If blRet = False Then
Err.Raise vbObjectError + 526, "ConvertReportToPDF.ConvertUncompressedSnaphot", _
"Sorry...damaged SnapShot File" & vbCrLf & _
"Please select a different Report to Export"
End If
' Do we open new PDF in registered PDF viewer on this system?
If StartPDFViewer = True Then
ShellExecuteA Application.hWndAccessApp, "open", sOutFile, vbNullString, vbNullString, 1
End If
' Success
ConvertReportToPDF = True
EXIT_CREATESNAP:
' Let's kill any existing Temp SnapShot file
'If Len(mUncompressedSnapFile & vbNullString) > 0 Then
On Error Resume Next
Kill mUncompressedSnapFile
mUncompressedSnapFile = ""
'End If
' If we aready loaded then free the library
If hLibStrStorage <> 0 Then
hLibStrStorage = FreeLibrary(hLibStrStorage)
End If
If hLibDynaPDF <> 0 Then
hLibDynaPDF = FreeLibrary(hLibDynaPDF)
End If
Exit Function
ERR_CREATSNAP:
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
mUncompressedSnapFile = ""
ConvertReportToPDF = False
Resume EXIT_CREATESNAP
End Function
精彩评论