Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

automatisches Erstellen von pdf

Betrifft: automatisches Erstellen von pdf von: detlef
Geschrieben am: 07.08.2008 17:02:59

Hallo alle zusammen,

ich nutze seit Monaten ein VBA zum automatischen Erstellen von PDF's. Grundlage war eine Muster aus Eurem Archiv Print to pdf von Ramses; habe ich auf meine Anforderungen angepasst.

Hat auch immer klaglos funktioniert.

Nun auf einmal Laufzeitfehler '429' Objekterstellung durch ActiveX-Komponente nicht möglich

Wer weiss Rat.

MFG
Detlef

  

Betrifft: AW: automatisches Erstellen von pdf von: ransi
Geschrieben am: 07.08.2008 17:26:25

HAllo Detlef

Wer weiss Rat.


Ohne deinen Code ???
Keine Chance !

ransi


  

Betrifft: AW: automatisches Erstellen von pdf von: Detlef
Geschrieben am: 07.08.2008 17:38:28

Hallo,

hier der code

Option Explicit
'Liest alle unter dem aktuell angemeldeten Benutzer
'installierten Drucker aus
'by Nepumuk
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
Sub Start_Print()
'by Ramses
'Druckt die übergebene Tabelle als PDF-Datei
'in das aktuelle Verzeichnis wo die Mappe gespeichert ist
Call Print_to_PDF(Sheets("Focus1"), "testBallon")
End Sub



Public Sub Print_to_PDF(tarWks As Worksheet, strNewDateiname As String)
    'by Ramses
    '*********************************
    'Verweise setzen auf
    'Microsoft Office 10.0 / 11.0 Object Library und
    'Acrobat Distiller
    '*********************************
    'Zusätzlich wird das Klassenmodul classAcroDist benötigt
    Dim myAdobeDist As classAcroDist 'see class module
    Dim myWB As Workbook
    Dim myWS As Worksheet
    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)
    'Worksheeet zuweisen
    Set myWS = tarWks
    
    '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
    strFilename = strFileToPrintPfad & "\" & strNewDateiname
    '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"
    myWS.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
        '***nichts tun
    Else
        MsgBox "Fehler beim Druck in PDF Datei aufgetreten"
    End If
    'Alten Drucker wieder herstellen
    Application.ActivePrinter = oldActivePrinter
    'Variablen leeren
    Set myAdobeDist = Nothing
End Sub





Function Get_Adobe_Printer() As String
'Adobe Drucker bestimmen
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



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)
        Debug.Print GetProfileString("PrinterPorts", strPrinterNames(intIndex), "", strBuffer,  _
Len(strBuffer))
        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)
            Debug.Print PrinterPort
        End If
    End If
End Sub


Sub procAusdruckStarten(temp_tarWks As Worksheet, tempNewDateiname As String)
Call Print_to_PDF(temp_tarWks, tempNewDateiname)
Application.Wait Now + TimeValue("00:00:01")
End Sub




  

Betrifft: AW: automatisches Erstellen von pdf von: Detlef
Geschrieben am: 07.08.2008 17:48:42

Hallo,

sorry, das Klassenmodul fehlt noch.

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
    'Altes PS-File löschen
    kill strInputPostScript
    'Distiller Log Datei löschen
    kill Left(strInputPostScript, Len(strInputPostScript) - 3) & ".log"
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




  

Betrifft: AW: automatisches Erstellen von pdf von: Ramses
Geschrieben am: 07.08.2008 20:07:47

Hallo

Wenn du auf "Debuggen" in der Fehlermeldung klickst, welche Zeile wird denn dann markiert ?

Gruss Rainer


  

Betrifft: AW: automatisches Erstellen von pdf von: detlef
Geschrieben am: 08.08.2008 10:21:10

Hallo Rainer,

Set myAdobeDist = New classAcroDist

Gruss
Detlef


  

Betrifft: AW: automatisches Erstellen von pdf von: Ramses
Geschrieben am: 11.08.2008 20:11:11

Hallo

??????
Sorry,... wenn du NICHTS geändert hast, habe ich keine Erklärung.
Welche Acrobat Version verwendest du jetzt?
Irgendein Adobe Update eingespielt oder auf eine höhere Version gewechselt ?

Gruss Rainer


  

Betrifft: AW: automatisches Erstellen von pdf von: Detlef
Geschrieben am: 29.08.2008 21:34:47

Hallo Rainer,

ich glaube jetzt habe ich die Erklärung. Anscheinend brauche ich AdminRechte. Als das Problem auftrat hatte ein freundlicher Geist aus der IT die AdminRechte auf meinen Firmenrechner gelöscht. Auf meinem Privatrechner läuft das nach wie vor.

Kann man an dem Ablauf basteln, damit er ohne AdminRechte auskommt? Meinen Programmablauf sollen auch andere Kollegen nutzen und die haben definitiv keine AdminRechte auf ihren Rechnern.

Gruss Detlef


 

Beiträge aus den Excel-Beispielen zum Thema "automatisches Erstellen von pdf"