Office: Pdf Dateien aus Excel Drucken,Fehlermeldungen

Hallo zusammen

Ich muss eine Excel Tabelle Haben bei der ich Pdf Dateien Drucken kann. Ich möchte in den Obersten Spalten Hyperlinks zu den jeweiligen Dateien erstellen und wen ich in die Zeile darunter ein x setzte, sollte es dann wen ich den Commandbutton drücke, die Dateien drucken. Ich habe jetzt versucht mit dem Code es umzusetzen. Nur wen ich den einfüge und dann das Klassenmodul einzufügen, kommt es beim auslösen immer eine fehlermeldung "Fehler beim Kompilieren, Benutzer definierter Typ nicht Definiert". Hab schon x-Sachen ausprobiert aber es will einfach nicht.

Hier mal der Code (das was ich rot markiert habe wird mir immer bei der fehlermeldung angezeigt)

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(ActiveSheet)
End Sub

Public Sub Print_to_PDF(tarWks As Worksheet) '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 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
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





Das Klassenmodul hab ich auch eingefügt wie beschrieben (da wird mir immer das blau markiert)

Option Explicit

Public WithEvents myAdobeDist As PdfDistillerPublic 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



Ich bin nicht sehr sachkundig mit dem Excel, vielen dank schonmal für eure Hilfe.

Gruss Andrin

:)

 

Bei diesem Code brauchst Du eine installierte Vollversion von Adobe Acrobat.

Ab Office 2007 ist die PDF-Erstellung mit eingebunden, so daß Du das nicht mehr benötigst

Willst Du PDF-Dateien erstellen und drucken?
Oder nur vorhandene PDF-Dateien drucken?
Welche Office-Version?

 

Ich arbeite mit dem 2010er Office. Ich möchte bestehende PDF Dateien Drucken, ich habe dann mehrere personen in den zeilen und damit ich es dann nicht alles durchzählen muss will ich einfach überall ein x machen können und es am Schluss ausdrucken. Damit man die Kontrolle hat was ich alles gedruckt haben und für wen.

 

Mir ist mal aufgefallen das dieser Code der falsche ist den ich brauche.
habe nun diesen gefunden der funktioniert auch gut. Nur möchte ich das es das Fenster um zur Datei auswählen nicht aufruft. Ich werde in der ersten Zeile alle Hyperlinks der Dateien (also ein Link pro Zelle) reinschreiben. Wie kann man das am besten mit dem Code machen, das wen ich in die unteren Spalten ein X setze sozusagen die anzahl Kopieen sind die ich möchte.
Sub pdf_mit_AR_drucken()
Set fs = CreateObject("Scripting.FileSystemObject")
Set WSHShell = CreateObject("WScript.Shell")
'Standarddrucker ermitteln
Dim objWMI As Object, objItem As Object
Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
ExecQuery("Select * from Win32_Printer where Default = 'true'")
On Error Resume Next
For Each objItem In objWMI
standarddrucker = objItem.properties_.Item("Name").Value
Next
Set objWMI = Nothing
'Pfad zum AdobeReader ermitteln
On Error Resume Next
strBezeichnung = WSHShell.RegRead("HKCR\.pdf\")
strZuordnung = WSHShell.RegRead("HKEY_CLASSES_ROOT\" & strBezeichnung & "\shell\open\command\")
strZuordnung = Replace(strZuordnung, Chr(34), "")
posEXE = InStr(UCase(strZuordnung), ".EXE")
If posEXE > 0 Then
anwendung = Left(strZuordnung, posEXE + 3)
Else
MsgBox "Installieren Sie erst Adobe Reader,dann versuchen wir weiter."
Exit Sub
End If
prog = fs.getfile(anwendung).shortpath & " /t "
anwendung = fs.getfile(anwendung).Name
'Datei zum Drucken auswählen
datei = Application.GetOpenFilename("PDF Dateien (*.pdf), *.pdf")
If VarType(datei) = vbBoolean Then Exit Sub
datei = fs.getfile(datei).shortpath
'Datei drucken
prog = prog & datei & " " & Chr(34) & standarddrucker & Chr(34)
' MsgBox prog
WSHShell.Run prog, 6, False
pause
Set WSHShell = Nothing
Set fs = Nothing
End Sub

Sub Programm_killen()
strComputer = "."
'zu killendes Programm 'AcroRd32.exe'
strProgramm = "'" & anwendung & "'"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = " & strProgramm)
For Each objProcess In colProcessList
objProcess.Terminate
Debug.Print objProcess.Name
Next
End Sub

Sub pause()
Application.OnTime Time + TimeValue("00:00:05"), "reader_killen"
End Sub

Sub reader_killen()
Dim druck As String
druck = ""
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colPrintJobs = objWMIService.ExecQuery("Select * from Win32_PrintJob")
For Each objPrintJob In colPrintJobs
druck = druck & objPrintJob.Name
Debug.Print druck
Next
If druck = "" Then
Programm_killen
Else
pause
End If
End Sub



Vielen Dank schon mal für die Hilfe

 

Ist es Überhaupt möglich dies zu machen?
Eine Pdf Datei via Hyperlink zu drucken, ohne das ich druckeinstellungen machen muss, das Adobe Reader sich wieder schliesst.
Zu dem weiss ich nicht welche Schleife sich genau eignet, um mir den Wert X in der Tabelle zusammenzählen und pro x als 1 Druckauftrag regeneriert. Dieser Druckauftrag würde sich erst auslösen sobald man eine AusführenSchaltfläche drückt.

Ich wäre um jeden tipp froh, da ich echt nirgends einen guten anhaltspunkt finde, auf was man so achten muss.

 

eine schleife könnte so aussehen :
(In Spalte A die Dateilinks, in Spalte B das x)

Code:

Schau Dir mal shellexecute im Netz an; damit sollte man den Druck auch starten können
vb@rchiv · API-Referenz · ShellExecute-Funktion

 

Dieser Code Funktioniert nicht bei mir.

Ich habe eine Idee, aber ich weiss jetzt nicht ganz wie ich dass umsetzten kann.

Die Brücke von dem Anzahl Druckäufträge zu Hyperlink drucken fehlt mir und mir geht momentan einfach kein Licht auf wie ich das zustande bringen soll.
Zur besseren Verständigung hab ich die Tabelle angehängt wie es Theoretisch dann aussehen soll.

PHP:

         Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal Hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long


Sub Drucken()


Product = "H:\Excel test\99999911_99.pdf"
ShellExecute 0, "open", Product, "", "", showminimized
ShellExecute 0, "print", Product, "", "", showmaximized
End Sub


 

Habe nun endlich einen richtigen Code gefunden.

In der Spalte C Kommen die Dateien(Hyperlinks) rein.
In der Spalte B der wert x.

Jetzt wollte ich aber das ich den Wert X in den Spalten B-Z, nur finde ich nicht herraus wo ich das ersetzten muss.


Wäre echt cool wen mir da jemand einen Tipp geben kann..
Ich verstehe die IngZeile Dekleration nicht ganz, würde mich auch über eine aufklärung freuen

PHP:

         Option Explicit

Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" ( _
ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Declare Function GetActiveWindow Lib "user32.dll" () As Long

Private Const MAX_PATH = 260&
Private Const SW_HIDE = 0&

Public Sub prcPrint_PDF()
Dim strPath As String, strShortPath As String, strFile As String
Dim lngZeile As Long

For lngZeile = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
If Sheets("Ende").Range("B" & lngZeile).Value = "x" Then
strFile = Range("C" & lngZeile).Text
strPath = "C:\Temp\"
strShortPath = Space(MAX_PATH)
GetShortPathName strPath & "" & strFile, strShortPath, MAX_PATH
ShellExecute GetActiveWindow, "print", strShortPath, "", strPath, SW_HIDE
End If
Next lngZeile

End Sub