Microsoft Access PDF Erzeugung / PDF Drucker
Dieses Codebeispiel zeigt wie Sie aus einem Access Report programatisch über VBA Macrocode ein PDF erzeugen. Sie erkennen, wie Sie das COM Interface dazu verwenden können um aus einem VBA Programm programatisch einen PDF Druck anzustarten.
Zuerst wird der 7-PDF Printer ermittelt und als Standarddrucker festgelegt, danach erfolgt der Druck des Access Reports in das PDF Format. Dabei werden benutzerdfinierte Einstellungen gesetzt die unter anderem einen Wasserzeichentext in den PDF Report rendern. Danach erfolgt die PDF Ausgabe und der ursprünglich als Standarddrucker definierte Drucker wird wieder als Standard gesetzt.
- Option Compare Database
- Option Explicit
- Sub PrintReportAsPDF()
- Dim pdf_printer_name As String
- Dim pdf_printer_index As Integer
- Dim current_printer_name As String
- Dim current_printer_index As Integer
- Dim i As Integer
- Dim progid As String
- Dim xmldom As Object
- Dim currentdir As String
- Dim pdfwriter As Object
- Rem -- Get the directory of the database
- currentdir = GetDatabaseFolder
- Rem -- Read the info xml
- Set xmldom = CreateObject("MSXML.DOMDocument")
- xmldom.Load (currentdir & "\info.xml")
- Rem -- Get the program id of the automation object.
- progid = xmldom.SelectSingleNode("/xml/progid").Text
- Rem -- Create the printer automation object
- Set pdfwriter = CreateObject(progid)
- Rem -- Printer specific settings
- pdf_printer_name = pdfwriter.GetPrinterName
- Rem -- Find the index of the printer that we want to use
- pdf_printer_index = -1
- current_printer_index = -1
- current_printer_name = Application.Printer.DeviceName
- For i = 0 To Application.Printers.Count - 1
- If Application.Printers.Item(i).DeviceName = pdf_printer_name Then
- pdf_printer_index = i
- End If
- If Application.Printers.Item(i).DeviceName = current_printer_name Then
- current_printer_index = i
- End If
- Next
- Rem -- Exit here if the pdf printer was not found
- If pdf_printer_index = -1 Then
- MsgBox "The printer '" & pdf_printer_name & "' was not found on this computer."
- Exit Sub
- End If
- Rem -- Exit here if the current printer was not found
- If current_printer_index = -1 Then
- MsgBox "The current printer '" & current_printer_name & "' was not found on this computer." & _
- " Without this printer the code will not be able to restore the original printer selection."
- Exit Sub
- End If
- Rem -- Set the printer
- Application.Printer = Application.Printers(pdf_printer_index)
- Rem -- Configure the PDF printer
- With pdfwriter
- Rem -- Set the destination file name of the PDF document
- .SetValue "output", GetDatabaseFolder & "\out\example.pdf"
- Rem -- Control the dialogs when printing
- .SetValue "ConfirmOverwrite", "yes"
- .SetValue "ShowSaveAS", "never"
- .SetValue "ShowSettings", "never"
- .SetValue "ShowPDF", "yes"
- Rem -- Set document properties
- .SetValue "Target", "printer"
- .SetValue "Title", "Access PDF Example"
- .SetValue "Subject", "Report generated at " & Now
- Rem -- Display page thumbs when the document is opened
- .SetValue "UseThumbs", "yes"
- Rem -- Set the zoom factor to 50%
- .SetValue "Zoom", "50"
- Rem -- Place a stamp in the lower right corner
- .SetValue "WatermarkText", "ACCESS DEMO"
- .SetValue "WatermarkVerticalPosition", "bottom"
- .SetValue "WatermarkHorizontalPosition", "right"
- .SetValue "WatermarkVerticalAdjustment", "3"
- .SetValue "WatermarkHorizontalAdjustment", "1"
- .SetValue "WatermarkRotation", "90"
- .SetValue "WatermarkColor", "#ff0000"
- .SetValue "WatermarkOutlineWidth", "1"
- Rem -- Write the settings to the runonce.ini file
- .WriteSettings True
- End With
- Rem -- Run the report
- DoCmd.OpenReport "Product Report"
- End Sub
- Function GetDatabaseFolder() As String
- Dim retv As String
- Dim p As Integer
- retv = Application.CurrentDb.Name
- p = InStrRev(retv, "\")
- If p > 0 Then
- retv = Left(retv, p)
- If Right(retv, 1) = "\" Then retv = Left(retv, Len(retv) - 1)
- Else
- Err.Raise 1000, , "Unable to determine database folder"
- End If
- GetDatabaseFolder = retv
- End Function
Downloads
Anhang | Größe |
---|---|
Codebeispiel herunterladen | 63.97 KB |