Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

automatisches Erstellen von pdf

automatisches Erstellen von pdf
07.08.2008 17:02:59
pdf
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

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: automatisches Erstellen von pdf
07.08.2008 17:26:25
pdf
HAllo Detlef

Wer weiss Rat.


Ohne deinen Code ?
Keine Chance !
ransi

AW: automatisches Erstellen von pdf
07.08.2008 17:38:00
pdf
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 



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


Anzeige
AW: automatisches Erstellen von pdf
07.08.2008 17:48:42
pdf
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


Anzeige
AW: automatisches Erstellen von pdf
07.08.2008 20:07:47
pdf
Hallo
Wenn du auf "Debuggen" in der Fehlermeldung klickst, welche Zeile wird denn dann markiert ?
Gruss Rainer

AW: automatisches Erstellen von pdf
08.08.2008 10:21:00
pdf
Hallo Rainer,
Set myAdobeDist = New classAcroDist
Gruss
Detlef

AW: automatisches Erstellen von pdf
11.08.2008 20:11:11
pdf
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

AW: automatisches Erstellen von pdf
29.08.2008 21:34:47
pdf
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
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige