PDA

Vollständige Version anzeigen : Tabellenblatt mittels VBA als PDF Dokument speichern.


Nemo2709
17.07.2012, 08:18
Hallo,
Ist es eigentlich möglich über einen Button den festgelegten Druckbereich als PDF file zu speichern so das man nur noch den Pfad eingeben muss?

Er soll halt gleich, nur und immer bei dieser Excel Datei den Vorschlag zum speichern das Format PDF nehmen.


Das ganze soll sich dann aber auch mit dem Standart Drucker vertragen den über einen anderen Button läuft schon der Druckvorgang für doppelseitiges Drucken. Nicht das hier der alles durcheinander geworfen wird!

Liebe Grüsse Nemo

EarlFred
17.07.2012, 08:21
Hallo Nemo,

wenn die Excelversion, auf der das laufen soll, < 2007 ist, dann teile bitte mit, welches pdf-Programm Du zum Erstellen verwendest.

Grüße
EarlFred

Nemo2709
17.07.2012, 08:44
Achso,
Die Excel Version ist noch 2003!:(

Und das PDF Programm ist die Premium Version von Adobe.

Wenn des was hilft. ;)

Grüße Nemo

Nemo2709
18.07.2012, 09:41
Ggggg

chris-kaiser
18.07.2012, 11:01
Hi

deine letzte Frage habe ich zwar nicht verstanden....

hier mal ein Code von Nepumuk, Verweise und das Klassenmodul behachten!!!

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

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

Public Sub Public_to_PDF(tarWks As Worksheet, strFileToPrintPfad As String, strDateiname As String)
'*********************************
'Verweise 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 DistInputPS As String
Dim DistOutputPDF As String
Dim DistJobOptions As String
Dim oldActivePrinter As String
Set myAdobeDist = New classAcroDist
'Distiller ausgeblendet starten
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)
'Dann wechsle vorher in den Pfad der Datei
ChDrive (Left(strFileToPrintPfad, 2))
ChDir myWB.Path
'Zur druckender Dateiname
strFilename = strFileToPrintPfad & "\" & strDateiname
'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"
ActiveWindow.SelectedSheets.PrintOut ActivePrinter:=Get_Adobe_Printer, prtoFilename:=DistInputPS, PrintToFile:=True
'Dem Distiller das PS-File zum konvertieren übergeben
Call myAdobeDist.myAdobeDist.FileToPDF(DistInputPS, DistOutputPDF, DistJobOptions)
'Alten Drucker wieder herstellen
Application.ActivePrinter = oldActivePrinter
'Variablen leeren
Set myAdobeDist = Nothing
End Sub


KLASSENMODULE

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

EarlFred
18.07.2012, 16:18
@Chris

meines Wissens nach reicht auch
ws.PrintOut ActivePrinter:="Adobe PDF", PrintToFile:=True, PrToFileName:=Filename
d. h. die Angabe des Ports ist nicht erforderlich. Ein schneller Test war erfolgreich.

Für die Ermittlung der angeschlossenen Drucker samt Ports habe ich mal folgenden schlanken Code von Anton entdeckt - vielleicht für Dein Archiv:
http://www.ms-office-forum.net/forum/showpost.php?p=1030471&postcount=11

Grüße
EarlFred

chris-kaiser
18.07.2012, 16:25
Hallo Earlfred

Danke!

Ich habe in der SuFu den Code von Nepumuk gefunden.
Ich selbst habe es nicht getestet..... denn
:grins: bei Nepumuk bin ich mir immer sicher das der Code funktioniert.

Den Link von Anton werde ich mal archivieren.

Nemo2709
19.07.2012, 08:46
Hallo Hallo earlfred,

Sorry das ich frag, aber ist dein Code alles? Ich mein im Gegenzug zum Chris- Kaisers Code ist das relativ wenig?

Ich habe beide Codes und Klassenmodule kopiert und eingefügt. Leider muss ich sagen das es nicht funktioniert. Ich geh mal davon aus, dass ich da der Fehler bin! Was muss ich wie wo beachten und wo genau kopiere ich eure Codes hin.
Wo muss ich noch welche Informationen hin schreiben?

Und warum ist das mit einer Funktion verbunden?


Sorry für die vielen Fragen!!

Liebe Grüße nemo

chris-kaiser
19.07.2012, 11:45
Hallo Nemo

Der Name des Klassenmodules muss genau stimmen
Die Verweise müssen gesetzt sein.
Die Codezuweisungen müssen stimmen.

Dann müsste der Code funktionieren.

vgl.
http://www.online-excel.de/fom/fo_read.php?f=1&bzh=15637&h=156..

oder

http://www.herber.de/forum/archiv/660to664/t662009.htm

Davon würde es noch ein paar geben.
Du bist nicht der einzige der damit Probleme hat....