Office: PDF aus Excel erstellen (Pfad nicht vorgeben)

drei1padsvb · 3. Mai 2012

Hallo zusammen,

durch folgenden Code lasse ich mir das aktuelle Tabellenblatt als PDF erstellen und unter einem vorgegebenen Pfad abspeichern.

Ich würde aber lieber den Pfad beim betätigen des Makros selbst bestimmen.
Sozusagen "Speichern unter".

Hier der Code:

Code:

Sub speichern()

Application.DisplayFullScreen = False

Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String

sPDFName = Cells(1, 1).Value
sPDFPath = "C:\Eigene Dateien\"

If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing

'Pfad = "E:\Werkstatt\Kundenreperaturen\2008\" 'Ordnernamen anpassen /JAHRESZAHL MANUELL ÄNDERN!!!
'Dateiname = Cells(7, 7).Value
'Datei = Pfad + Trim(Dateiname) + ".xls"
'ActiveWorkbook.SaveAs Filename:=Datei, FileFormat:=xlNormal, Password:="", WriteResPassword:=""
'ReadOnlyRecommended:= _False, CreateBackup:= _False
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Application.DisplayAlerts = False
If Application.Workbooks.Count = 1 Then

'Application.Quit
Else
ActiveWorkbook.Close
'evtl ActiveWorkbook, wenns via Button gehen soll
End If
Application.DisplayAlerts = False

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Folgende Zeile gibt den Pfad vor:
Code:

sPDFPath = "C:\Eigene Dateien\"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Dies soll aber ersetzt werden und die Funktion ermöglichen, das erstellte PDF-Dokument unter einem beliebigen Pfad zu speichern.

Ich hoffe ich habe das ganze verständlich erklärt.
Ansonsten einfach nochmal nachhaken.

Vielen Dank schonmal für euer Mühe!

:)

aloys78 · 5. Mai 2012

Hallo,

Dies soll aber ersetzt werden und die Funktion ermöglichen, das erstellte PDF-Dokument unter einem beliebigen Pfad zu speichern.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Da sehe folgende Möglichkeiten:
a) Abfrage und Eingabe des Pfades über eine Inputbox
b) Definition von infragekommenden Pfaden in einer Tabelle, Anzeige und Auswahl über ComboBox, die zusätzlich die freie Eingabe zuläßt.

Gruß
Aloys

mumpel · 5. Mai 2012

Hallo!

sPath = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & "\Documents\" & "File1", _
FileFilter:="PDF-Datei (*.pdf),*.pdf")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß, René

drei1padsvb · 5. Mai 2012

Vielen Dank mumpel. Das klappt schon fast perfekt!
Auch vielen Dank an aloys78 für Deine Antwort!

Folgendes Problem hab ich aber noch.

An dem Ort, an dem ich die .pdf-Datei speichern lasse, erzeugt er einen Ordner, in dem dann die Datei abgespeichert wirt.

Ist bestimmt einfach den Fehler zu finden, aber ich komm grad leider nicht weiter.

Hier der momentane Code:

Code:

Sub speichern()

Application.DisplayFullScreen = False

Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String

sPDFName = Cells(1, 1).Value
'sPDFPath = "C:\Eigene Dateien\"

sPath = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & "\Documents\" & "File1", _
FileFilter:="PDF-Datei (*.pdf),*.pdf")

If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
'.cClearCache
End With

ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing

'Pfad = "E:\Werkstatt\Kundenreperaturen\2008\" 'Ordnernamen anpassen /JAHRESZAHL MANUELL ÄNDERN!!!
'Dateiname = Cells(7, 7).Value
'Datei = Pfad + Trim(Dateiname) + ".xls"
'ActiveWorkbook.SaveAs Filename:=Datei, FileFormat:=xlNormal, Password:="", WriteResPassword:=""
'ReadOnlyRecommended:= _False, CreateBackup:= _False
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Application.DisplayAlerts = False
If Application.Workbooks.Count = 1 Then

'Application.Quit
Else
ActiveWorkbook.Close
'evtl ActiveWorkbook, wenns via Button gehen soll
End If
Application.DisplayAlerts = False

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mumpel · 5. Mai 2012

Das ist ganz einfach erklärt. "AutoSaveDirectory" erwartet den Pfad, "AutosaveFilename" erwartet den Dateinamen. Du musst "sPath" so aufsplitten dass Pfad und Dateiname getrennt sind.

Versuch es mit folgendem Code.

In ein allgemeines Modul:

Option Explicit

Sub speichern()

Application.DisplayFullScreen = False

If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

sPDFName = Cells(1, 1).Value

sPath = BrowseForFolder("Bitte Ordner auswählen", "C:\temp")
If sPDFPath <> "" Then
sPDFPath = sPath & "\"
End If

If MsgBox("Soll die Datei nach dem Erstellen angezeigt werden?", vbYesNo, "Frage") = vbYes Then xlOpenPDFAfterPublish = True

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveStartStandardProgram") = IIf(xlOpenPDFAfterPublish = True, 1, 0)
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0
.cClearCache
End With

ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose

Application.DisplayAlerts = False

If Application.Workbooks.Count = 1 Then

Else
ActiveWorkbook.Close
End If

Application.DisplayAlerts = False

End Sub

VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann: VBA in HTML 2.0
Persönliche Version bearbeitet von mumpel
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

drei1padsvb · 6. Mai 2012

Hi und nochmals besten Dank für deine Hilfe!!!

Bei folgendem Code bekomme ich jedoch folgende Fehlermeldung.

Code:
Code:

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
Public 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
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Fehlermeldung:
http://desmond.imageshack.us/Himg855...pg&res=landing

mumpel · 6. Mai 2012

Da kann ich nicht helfen. Das liegt daran dass Du offensichtlich die 64-bit-Version von Office 2010 verwendest. Deinstalliere die 64-bit-Version (die hat ohnehin keine Vorteile für Normalanwender) und installiere dann die 32-bit-Version. Solltest Du die 64-bit-Version verwenden wollen/müssen, dann google mal nach dem Stichwort PtrSafe.

Sa4rah · 11. Juni 2013

Hallo Ihr Profis!

Bei mir hat der Code soweit super probiert, nachdem ich übertrieben lang nach eine Lösung mit plausibler Erklärung für VBA Anfänger gesucht habe.

Ich habe allerdings noch eine Fehlermeldung (siehe Anhang)

Was kann ich da tun?

Vielen Dank im Vorraus!

Liebe Grüße,
Sar4ah

mumpel · 11. Juni 2013

Hallo!

Hast Du den PDF-Creator überhaupt installiert?

Gruß, René

Sa4rah · 12. Juni 2013

Ja das wirds nämlich sein. bei mir heisst das Ding jetzt wohl PDF X-Change.

wie könnte ich den Code so umformulieren, dasss der Code den jeweilegen PDF umwandler andwendet, der auf dem PC des Nutzers installiert ist ?
Das ist vermutlich sehr kompliziert...

mumpel · 12. Juni 2013

Das wird nichts. "PDF X-Change" lässt sich meiner Kenntnis nach nicht per programmatischen Zugriff steuern, schon gar nicht mit diesem Code. Für jedes PDF-Programm benötigt man eigenen Programmcode für den programmatischen Zugriff. Bei vielen PDF-Programmen kann man nur über die Command-Line programmatischen Zugriff nehmen.

Ab Office 2007 kannst Du ExportAsFixedFormat nutzen. Die Forensuche bringt Dir zahlreiche Beispiele.

Sa4rah · 13. Juni 2013

Danke René !

Ich habd as mal versucht, allerdings ist mir nicht ganz klar wo und wie genau ich das dann einfüge in den bestehenden code...

ich dachte anstatt

Code:

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

aber da hats nicht funktioniert, weil mir nich klar ist wie ich das formuliere und ob ich was vergessen hab...

mumpel · 13. Juni 2013

Was hast Du probiert und wie genau?

Office: PDF aus Excel erstellen (Pfad nicht vorgeben)

PDF aus Excel erstellen (Pfad nicht vorgeben)

PDF aus Excel erstellen (Pfad nicht vorgeben)

PDF aus Excel erstellen (Pfad nicht vorgeben)

PDF aus Excel erstellen (Pfad nicht vorgeben)

PDF aus Excel erstellen (Pfad nicht vorgeben)

PDF aus Excel erstellen (Pfad nicht vorgeben) - Similar Threads - PDF Excel erstellen

pdf drucken mit button in excel einfügen

Excel Tabellenblatt als PDF speichern unter Vorgabe Dateinamen aus einer Zelle

XY-Diagramm-Grafik mit zusätzlichen Daten erweitern

huge PDF to EXCEL

VBA Makro - PDF erstellen und speichern auf lokalem Netzwerk

Excel Tabelle aus PDF erstellen? (NUR durch Strg-C und Strg-V !!!)

Aus Excel-Datei PDF mit Bookmarks erstellen