Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
904to908
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
904to908
904to908
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

PDF automatisch drucken

PDF automatisch drucken
14.09.2007 13:33:00
Günther
Hallo, liebe Excelgemeinde, lieber Rainer "Ramses",
um PDF's aus Excel-VBA zu drucken habe ich die Module und Klassenmodule aus dem "Ramses"-Beitrag vom 3.9.2005 aus dem Archiv-Paket 660 - 664 kopiert und in meine Mappe integriert; leider klappt das mit dem PDF-Erzeugen nicht so ganz und ich bekomme in der Zeile "Public WithEvents myAdobeDist As PdfDistiller" die Fehlermeldung: "Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert."
Was muss ich tun?. Vielen Dank schon mal im Vorraus und liebe Grüße
Günther

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: PDF automatisch drucken
14.09.2007 14:31:30
Gerd
Hi,
vermutlich ist der Verweis auf die erforderlich Bibliothek, die den PdfDistiller enthält,
nicht gesetzt.
mfg Gerd

AW: PDF automatisch drucken
14.09.2007 14:35:00
Ramses
Hallo
Ich weiss nicht ob der Beitrag dort vollständig ist, daher hier nochmal der ganze Code.
Wichtig ist auf jeden Fall:
Der Adobe Distiller aus dem Adobe Acrobat 6/7 MUSS installiert sein. Mit dem Reader alleine geht es nicht, auch nicht mit dem Adobe Writer
Option Explicit
'Code zur Verwendung mit Adobe Acrobat 6./7.0

'Im VB-Editor die Verweise setzen auf die Objectlibraries:
'Microsoft Office 10.0 bzw. 11.0 Object Library
'Acrobat Distiller
'Acrobat Application

'Liest alle unter dem aktuell angemeldeten Benutzer
'installierten Drucker aus
'by Nepumuk
'Bestandteil der Entwicklungsumgebung für diesen Code

Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" ( _
    ByVal lpAppName As String, _
    ByVal lpKeyName As String, _
    ByVal lpDefault As String, _
    ByVal lpReturnedString As String, _
    ByVal nSize As Long) As Long


Private Const MAX_PRINTERS = 16
Private strPrinterNames(MAX_PRINTERS) As String
Private strPrinterDrivers(MAX_PRINTERS) As String
Private strPrinterPorts(MAX_PRINTERS) As String
Private intPrinterCount As Integer

Private Sub prcGetPrinterNames(ByVal strBuffer As String)
    Dim intIndex As Integer
    Dim strName As String
    intPrinterCount = 0
    Do
        intIndex = InStr(strBuffer, Chr(0))
        If intIndex > 0 Then
            strName = Left$(strBuffer, intIndex - 1)
            If Len(Trim$(strName)) > 0 Then
                strPrinterNames(intPrinterCount) = Trim$(strName)
                intPrinterCount = intPrinterCount + 1
            End If
            strBuffer = Mid$(strBuffer, intIndex + 1)
        Else
            If Len(Trim$(strBuffer)) > 0 Then
                strPrinterNames(intPrinterCount) = Trim$(strBuffer)
                intPrinterCount = intPrinterCount + 1
            End If
            strBuffer = ""
        End If
    Loop While (intIndex > 0) And (intPrinterCount < MAX_PRINTERS)
End Sub
Private Sub prcGetPrinterPorts()
    Dim strBuffer As String
    Dim intIndex As Integer
    For intIndex = 0 To intPrinterCount - 1
        strBuffer = Space$(1024)
        GetProfileString "PrinterPorts", strPrinterNames(intIndex), "", strBuffer, Len(strBuffer)
        prcGetDriverAndPort strBuffer, strPrinterPorts(intIndex)
    Next
End Sub

Private Sub prcGetDriverAndPort(ByVal Buffer As String, PrinterPort As String)
    Dim intDriver As Integer
    Dim intPort As Integer
    PrinterPort = ""
    intDriver = InStr(Buffer, ",")
    If intDriver > 0 Then
        intPort = InStr(intDriver + 1, Buffer, ",")
        If intPort > 0 Then
            PrinterPort = Mid$(Buffer, intDriver + 1, intPort - intDriver - 1)
        End If
    End If
End Sub

'Adobe Print Job
'(C) by Ramses
'**********************************************
'Mit dieser Sequenz wird der Ausdruck gestartet
Sub Start_Print()
    'Druckt die übergebene Tabelle als PDF-Datei
    'in das aktuelle Verzeichnis wo die Mappe gespeichert ist
    Call Print_to_PDF(ActiveSheet)
End Sub
'**********************************************

Public Sub Print_to_PDF(tarWks As Worksheet)
    '(C) by Ramses
    '*********************************
    'Verweise setzen auf
    'Microsoft Office 10.0 / 11.0 Object Library und
    '"Acrobat Distiller" sowie "Acrobat" (Apllication)
    '*********************************
    'Zusätzlich wird das Klassenmodul classAcroDist benötigt
    '*********************************
    Dim myAdobeDist As classAcroDist 'see class module
    Dim myWB As Workbook
    Dim strFileName As String
    Dim strFileToPrintPfad As String
    Dim DistInputPS As String
    Dim DistOutputPDF As String
    Dim DistJobOptions As String
    Dim oldActivePrinter As String
    Set myAdobeDist = New classAcroDist
    'Distiller ausgeblendet startetn
    myAdobeDist.myAdobeDist.bShowWindow = False
    'Alle aktuellen Printjobs des Distillers stoppen
    myAdobeDist.myAdobeDist.bSpoolJobs = False
    'Alten Drucker aufnehmen
    oldActivePrinter = Application.ActivePrinter
    'Workbook zuweisen
    Set myWB = Workbooks(tarWks.Parent.name)
    'Pfad der Mappe extrahieren
    strFileToPrintPfad = myWB.Path
    'Dann wechsle vorher in den Pfad der Datei
    ChDrive (Left(strFileToPrintPfad, 2))
    ChDir myWB.Path
    'Zur druckender: Mappenname_Tabelle1
    strFileName = strFileToPrintPfad & "\" & Left(myWB.name, Len(myWB.name) - 4) & "_" & tarWks.name
    'EXCEL kann nur PS-Files direkt drucken
    'daher muss sowohl PS-File wie auch PDF-File definiert werden
    DistInputPS = strFileName & ".ps"
    DistOutputPDF = strFileName & ".pdf"
    'Der Druckername wird automatisch ermittelt
    'in der Funktion "Get_Adobe_Printer"
    myWB.PrintOut ActivePrinter:=Get_Adobe_Printer, prtoFilename:=DistInputPS, PrintToFile:=True
    'Dem Distiller das PS-File zum konvertieren übergeben
    Call myAdobeDist.myAdobeDist.FileToPDF(DistInputPS, DistOutputPDF, DistJobOptions)
    'Schauen wie lange er braucht
    'und Status OK meldet
    Do While Not myAdobeDist.blnFinished
        DoEvents
    Loop
    If myAdobeDist.blnFinished Then
        MsgBox "PDF Printjob erfolgreich beendet"
    Else
        MsgBox "Fehler beim Druck in PDF Datei aufgetreten"
    End If
    'Alten Drucker wieder herstellen
    Application.ActivePrinter = oldActivePrinter
    'Variablen leeren
    Set myAdobeDist = Nothing
    Open_PDF DistOutputPDF
End Sub


Sub Open_PDF(fileToOpen As String)
    '(C) by Ramses
    '****************
    'Verweis auf Acrobat Application setzen !!!
    '****************
    Dim myAdobeAc As Acrobat.CAcroApp
    Dim myAdobeDoc As Acrobat.CAcroPDDoc
    Dim myAdobeView As Acrobat.CAcroAVDoc
    'Adobe Application zuweisen
    Set myAdobeAc = CreateObject("AcroExch.App")
    'Adobe Dokument Handler zuweisen
    Set myAdobeDoc = CreateObject("AcroExch.PDDoc")
    If myAdobeDoc.Open(fileToOpen) Then
        myAdobeAc.Show
        'Adobe View Handler zuweisen
        'um mit dem Dokument allenfalls arbeiten zu können
        'via VBA
        Set myAdobeView = myAdobeDoc.OpenAVDoc("")
    Else
        MsgBox "Unable to open the PDF-file", vbInformation
    End If
    Set myAdobeView = Nothing
    Set myAdobeDoc = Nothing
    Set myAdobeAc = Nothing
End Sub


Function Get_Adobe_Printer() As String
    '(C) by Ramses
    'Adobe Drucker bestimmen
    'Code zum Druckerauslesen ist Bestandteil dieses Codes
    Dim strBuffer As String
    Dim intIndex As Integer
    strBuffer = Space$(8192)
    GetProfileString "PrinterPorts", vbNullString, "", strBuffer, Len(strBuffer)
    prcGetPrinterNames strBuffer
    prcGetPrinterPorts
    For intIndex = 0 To intPrinterCount
        If InStr(1, strPrinterNames(intIndex), "Adobe") > 0 Then
            'Genaue Druckerbezeicnung übergeben
            Get_Adobe_Printer = strPrinterNames(intIndex) & " auf " & strPrinterPorts(intIndex)
            Exit For
        End If
    Next
End Function


'Nur zur Entwicklung nötig
Public Sub Print_PrinterList()
    '(C) by Ramses
    'gibt alle installierten Drucker im Debug.Fenster aus
    Dim strBuffer As String
    Dim intIndex As Integer
    strBuffer = Space$(8192)
    GetProfileString "PrinterPorts", vbNullString, "", strBuffer, Len(strBuffer)
    prcGetPrinterNames strBuffer
    prcGetPrinterPorts
    For intIndex = 0 To intPrinterCount - 1
        'If InStr(1, strPrinterNames(intIndex), "Adobe") > 0 Then
        Debug.Print strPrinterNames(intIndex) & " auf " & strPrinterPorts(intIndex)
        'End If
    Next intIndex
End Sub

'********************************************************
'Das gehört in ein Klassenmodul deiner Arbeitsmappe
'Das Klassenmodul muss in diesem Beispiel
'den Namen "classAcroDist" haben

Option Explicit

Public WithEvents myAdobeDist As PdfDistiller
Public blnFinished As Boolean

Private Sub Class_Initialize()
    Set myAdobeDist = New PdfDistiller
End Sub

Private Sub myAdobedist_OnJobDone(ByVal strInputPostScript As String, ByVal strOutputPDF As String)
    blnFinished = True
    Kill strInputPostScript
End Sub

Private Sub myAdobedist_OnJobFail(ByVal strInputPostScript As String, ByVal strOutputPDF As String)
    blnFinished = True
End Sub

Private Sub myAdobedist_OnJobStart(ByVal strInputPostScript As String, ByVal strOutputPDF As String)
    blnFinished = False
End Sub


Alternativ bieten sich auch andere PDF Printer in der Zwischenzeit an, welche von der VBA-Umgebung direkt unterstützt werden.
Z.B. https://sourceforge.net/projects/pdfcreator/
und der zugehörige VBA-Code
http://excelguru.ca/node/21
Gruss Rainer

Anzeige
AW: PDF automatisch drucken
15.09.2007 11:26:00
Günther
Vielen Dank Euch beiden für die tolle Hilfe; werde es am Montag in der Firma gleich ausprobieren.
Ciao.
Günther

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige