Anzeige
Archiv - Navigation
1136to1140
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Sub PDF_Print_Sheet()

Sub PDF_Print_Sheet()
Sandra
Guten Morgen zusammen.
Ich muss ein Makro zusammen bauen, bei dem ich Eure Hilfe benötige. Es funktioniert scheinbar nur über diesen Weg der VBA-Programmierung.
Ich habe eine Exceldatei mit vielen Tabellenblättern. Nun möchte ich alle markierten Tabellenblätter als pdf drucken - von mir aus auch speichern als pdf. Dabei soll aber die Seitennummerierung der Tabellenblätter beibehalten werden, die mit den Variablen [Seite] & [Seiten] (also: Seite [Seite] & von Seite [Seiten]) festgelegt sind. Habe ich im TB1 3 Seiten (1 von 3, 2 von 3 und 3 von 3) und im TB2 2 Seiten (1 von 2 und 2 von 2), dann möchte ich diese Seitenzahlen auch im pdf-Ausdruck wiederfinden und nicht 1 von 5, 2 von 5 etc.
Geht das irgendwie? Und wenn ja, wie?
P. s. Das Makro muss für verschiedene Betriebssysteme (XP, Vista und 7) funktionieren (ggfs. mit dieser Funktion: Environ("userprofile") & "\Desktop\" & .Name & ".pdf") und ggfs. auch mit unterschiedlichen Adobe-Ausgaben 8.0, 9.0 etc. Die Excelversion ist bei allen Excel 2007. Wenn es über die Funktion Speichern unter als pdf" läuft ist es ja egal welche Adobe-Ausggabe jeder einzelne hat.
Das Makro sollte so aufgebaut sein, das die pdf-Datei auf dem Desktop gespeichert wird. Dazu könnte dann eine Abfrage eingebaut werden, die den Namen der Datei erfragt und, die ggfs. prüft, ob eine DAtei mit diesem Namen schon vorhanden ist.
Ich hatte von Tino einen Lösungsvorschlag bekommen. Der sieht wie folgt aus:
Sub Makro1()
Dim oWB As Workbook
Dim oSh As Worksheet
Dim objShell As Object
Dim Desktop As String
Dim strPDF_Name As String
strPDF_Name = InputBox("Geben sie den Namen der Pdf Datei an", "Name vergeben")
If strPDF_Name = "" Then Exit Sub
strPDF_Name = IIf(Right$(LCase(strPDF_Name), 4) = ".pdf", strPDF_Name, strPDF_Name & ".pdf")
Set objShell = CreateObject("WScript.Shell")
Desktop = objShell.SpecialFolders("Desktop")
Desktop = IIf(Right$(Desktop, 1) = "\", Desktop, Desktop & "\")
If Dir(Desktop & strPDF_Name)  "" Then
If MsgBox("Datei mit den Namen " & strPDF_Name & " schon vorhanden!" & vbCr & _
"Wollen Sie diese ersetzen?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
Application.ScreenUpdating = False
ActiveWindow.SelectedSheets.Copy
Set oWB = ActiveWorkbook
For Each oSh In oWB.Worksheets
oSh.PageSetup.RightFooter = "Seite &P von &N"
Next oSh
oWB.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Desktop & "Name.pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, OpenAfterPublish:=False
oWB.Close False
Application.ScreenUpdating = True
End Sub

Dabei gibt es aber zwei Probleme.
1. Die Datei wird nicht mit dem Namen gespeichert, den ich im Feld eingetragen habe. Diese Datei heißt immer "Name".
2. Die Nummerierung ist nach wie vor fortlaufend.
Kann mir hierbei irgendjemand weiterhelfen?
P. s. Ich habe dieses neu verfasst, da mein alter Beitrag nicht mehr in der Forumsliste auftaucht.
Liebe Grüße
Sandra
Ich danke Euch herzlichst
Eure Sandra!

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Sub PDF_Print_Sheet()
09.02.2010 10:30:48
Ramses
Hallo
Es muss ja auch
oWB.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Desktop & strPDF_Name, Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, OpenAfterPublish:=False
heissen.
Des weiteren ist die Frage nun:
In deiner ersten Frage sollten die Seitenzahlen über das gesamte Dokument fortlaufend sein.
Nun müssen die Seitenzahlen so bleiben wie sie sind.
Der Ausdruck in ein einzelnes PDF-Dokument, also wo die unterschiedlichen Worksheets zusammengefasst sind, ist so nicht möglich.
Es ist auch nicht so ohne weiteres möglich, ALLE Adobe Versionen zu berücksichtigen. Das ist aufwändig und erfordert Zeit. Hier würde ich dir empfehlen, einen professionellen Programmierer zu beschäftigen.
Mit der Office-Funktion "Speichern als PDF" ist es grundsätzlich nicht möglich
Gruss Rainer
Anzeige
AW: Sub PDF_Print_Sheet()
09.02.2010 11:35:26
Sandra
Hallo Rainer,
die Seitenzahlen sollen eben nicht fortlaufend sein. Dann musst Du da etwas falsch verstanden haben oder ich habe mich falsch ausgedrückt. Dann könnte ich ja einfach "Speichern unter" oder "Drucken" als pdf machen.
Ich habe nicht gewusst das es so kompliziert ist.
Kann man denn mein altes Makro (welches alle markierten Tabellenblätter automatisch als einzelne Dateien auf dem Desktop speichert - Dateiname = Name des Tabellenblattes) ggfs. so erweitern, dass die einzelnen pdf-Dokumente in gleicher Reichenfolge (wie in der Excel-Arbeitsmappe) wieder zusammengefasst werden?
Kann man das Makro noch dahingehend ändern, dass die erstellten, einzelnen pdf-Dateien nach dem Erstellen nicht geöffnet werden? Bei einem Tabellenblatt ist es ja schick, aber die Dateien, bei denen ich dieses Makro benutze, haben mind. 45 Tabellenblätter und mehr.
Ich danke Dir und auch allen Anderen für die Hilfe und Geduld.
Liebe Grüße
Sandra
Anzeige
AW: Sub PDF_Print_Sheet()
09.02.2010 11:42:30
Ramses
Hallo
Das habe ich dir schon mal gesagt
Datei - speichern unter - PDF oder XPS
Klick auf "Tools" in diesem dialog
und markier die Option "Gesamte Arbeitsmappe"
Userbild
Dann geht ALLES in ein PDF Dokument
Gruss Rainer
AW: Sub PDF_Print_Sheet()
09.02.2010 12:03:06
Sandra
Hallo Rainer. Ich glaube wir belassen es an dieser Stelle dabei. Wir verstehen uns bei diesem Thema grundlegend falsch.
Ich weiß wie ich aus ganz vielen Tabellenblättern eine Datei bekomme. Das Problem ist nach wie vor die Seitennummerierung. Ich möchte nicht alle Seiten fortlaufend nummeriert haben. Das kommt aber bei allen Variationen raus.
Um das zu umgehen nutze ich im Moment das Makro, welches alle Tabellenblätter als einzelne Dateien abspeichert. Dann nutze ich die pdf-Funktion zusammenführen. In diesem Fenster muss ich dann aber alle einzelnen Dateien sortieren, damit die Reihenfolge mit der in der Excel-Arbeitsmappe identisch ist. Das ist eine Sauarbeit bei 45 Tabellenblätter/ pdf-Dateien und mehr. Daher habe ich gehoft die fortlaufende Nummerierung auf allen Tabellenblättern irgendwie umgehen zu können, so dass die Nummerierung der einzelnen Tabellenblätter beibehalten wird. Oder aber das Zusammenführen der einzelnen pdf-Dateien in richtiger Reihenfolge automatisieren zu können.
Aber es scheint nicht zu gehen. Danke und Gruß
Sandra
Anzeige
Danke trotzdem - letzte Frage
09.02.2010 13:00:32
Sandra
Eine letzte Frage habe ich, das wäre vielleicht ein Ansatz für mich.
Ist es möglich, dem Makro zu sagen - geh in die Markierten Tabellenblätter und setze in die Fußzeile die Seitenzahl (als feste Zahl/ Text) - und ganz zum Schluss wieder sagen, dass diese Aktion rückgängig gemacht wird?
Gruß Sandra
Anzeige
AW: Danke trotzdem - letzte Frage
09.02.2010 13:04:19
Ramses
Hallo
Nicht nötig, das wird im Makro bereits berücksichtigt. Es druckt alle Tabellen einzeln aus, und fügt diese zu einem Dokument zusammen
Gruss Rainer
AW: Danke trotzdem - letzte Frage
09.02.2010 13:21:19
Sandra
Du meinst in dem Makro, wo Du mir eben den Link geschrieben hast? Das läuft bei mir leider nicht. Ich kann es auch alleine leider nicht dahin gehend anpassen, dass es bei mir funktioniert.
Lieben Gruß
Sandra
Sub PDF_Print_Sheet()
10.02.2010 12:36:10
Sandra
Hallo zusammen,
vielleicht hat ja jemand eine Idee, warum dieses Makro bei mir nicht läuft:
Die aller erste Meldung die ich bei Versuch es auszuführen bekomme ist dies hier:
Userbild
Hier das Makro:
Public Sub PrintSheetsToPDF( _
ByVal SheetsToPrint As Variant, _
ByVal PDFFilePath As String _
)
' Print the specified sheets to a PDF file in the order specified. Requires
' Adobe Acrobat 7.0 and a reference to Acrobat Distiller.
' Syntax
' PrintSheetsToPDF(Sheets, PDFFilePath)
' SheetsToPrint - Array of sheet names to be printed. The sheets included are
'   sorted in that order and then printed in one print job. When the printing
'   is complete the original order is restored.
' PDFFilePath - Full path to the PDF file.
' Example
' Print sheets "Sheet4", "Sheet10", and "Sheet1" in that order:
'   PrintSheetsToPDF Array("Sheet4", "Sheet10", "Sheet1", "C:\Output.PDF")
Dim OriginalActiveWorksheet As Worksheet
Dim OriginalOrderNames As Variant
Dim Index As Long
Dim PDFDistillerApplication As PdfDistiller
Dim TempPFFilePathName As String
Dim PDFLogPathName As String
Dim Result As Long
' Normalize the sheet to print parameter
If Not IsArray(SheetsToPrint) Then SheetsToPrint = Array(SheetsToPrint)
For Index = LBound(SheetsToPrint) To UBound(SheetsToPrint)
If TypeName(SheetsToPrint(Index)) = "Worksheet" Then SheetsToPrint(Index) = SheetsToPrint( _
Index).Name
Next Index
' Normalize the output pdf file name
If LCase(Right(PDFFilePath, 4))  ".pdf" Then PDFFilePath = PDFFilePath & ".pdf"
' Save the current active worksheet
Set OriginalActiveWorksheet = ActiveSheet
' Save the current sheet order
ReDim OriginalOrderNames(1 To ThisWorkbook.Sheets.Count)
For Index = 1 To ThisWorkbook.Sheets.Count
OriginalOrderNames(Index) = ThisWorkbook.Sheets(Index).Name
Next Index
' Reorder the worksheets
For Index = UBound(SheetsToPrint) To LBound(SheetsToPrint) Step -1
If ThisWorkbook.Sheets(SheetsToPrint(Index)).Index > 1 Then
ThisWorkbook.Sheets(SheetsToPrint(Index)).Move Before:=ThisWorkbook.Sheets(1)
End If
Next Index
' Print the worksheets
TempPFFilePathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "pf"
PDFLogPathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "log"
On Error Resume Next
Kill TempPFFilePathName
On Error GoTo 0
ThisWorkbook.Worksheets(SheetsToPrint).PrintOut ActivePrinter:="Adobe PDF", PrintToFile:= _
True, Collate:=True, PrToFilename:=TempPFFilePathName
' Restore the original worksheet order
For Index = 1 To ThisWorkbook.Sheets.Count
If ThisWorkbook.Sheets(OriginalOrderNames(Index)).Index  Index Then
ThisWorkbook.Sheets(OriginalOrderNames(Index)).Move Before:=ThisWorkbook.Sheets(Index)
End If
Next Index
' Restore the original active worksheet
OriginalActiveWorksheet.Activate
' Convert the postscript file to .pdf
Set PDFDistillerApplication = New PdfDistiller
Result = PDFDistillerApplication.FileToPDF(TempPFFilePathName, PDFFilePath, "")
On Error Resume Next
Kill TempPFFilePathName
If Result = 1 Then Kill PDFLogPathName
End Sub
Ich denke es fehlt der Makroname. Wenn ich aber z. B. Sub PDF_Print_Sheet() in die erste Zeile Schreibe, dann erwarter er ein End Sub , da ja in der ursprünglich ersten Zeile schon ein Sub steht.
Wenn das behoben wird, kommt aber sicher die nächste Fehlermeldung, da das Makro nicht für mich gemacht wurde.
Hat jemand Lust, Zeit und etwas Geduld, mir dabei zu helfen?
@Rainer - DANKE für die tolle Hilfe. Das Du keine Lust mehr hast verstehe ich.
Bis später und liebe Grüß
Sandra
Anzeige
Sub PDF_Print_Sheet()
10.02.2010 16:03:55
Sandra
Hallo zusammen,
vielleicht hat ja jemand eine Idee, warum dieses Makro bei mir nicht läuft:
Die aller erste Meldung die ich bei Versuch es auszuführen bekomme ist dies hier:
Userbild
Hier das Makro:
Public Sub PrintSheetsToPDF( _
ByVal SheetsToPrint As Variant, _
ByVal PDFFilePath As String _
)
' Print the specified sheets to a PDF file in the order specified. Requires
' Adobe Acrobat 7.0 and a reference to Acrobat Distiller.
' Syntax
' PrintSheetsToPDF(Sheets, PDFFilePath)
' SheetsToPrint - Array of sheet names to be printed. The sheets included are
'   sorted in that order and then printed in one print job. When the printing
'   is complete the original order is restored.
' PDFFilePath - Full path to the PDF file.
' Example
' Print sheets "Sheet4", "Sheet10", and "Sheet1" in that order:
'   PrintSheetsToPDF Array("Sheet4", "Sheet10", "Sheet1", "C:\Output.PDF")
Dim OriginalActiveWorksheet As Worksheet
Dim OriginalOrderNames As Variant
Dim Index As Long
Dim PDFDistillerApplication As PdfDistiller
Dim TempPFFilePathName As String
Dim PDFLogPathName As String
Dim Result As Long
' Normalize the sheet to print parameter
If Not IsArray(SheetsToPrint) Then SheetsToPrint = Array(SheetsToPrint)
For Index = LBound(SheetsToPrint) To UBound(SheetsToPrint)
If TypeName(SheetsToPrint(Index)) = "Worksheet" Then SheetsToPrint(Index) = SheetsToPrint( _
Index).Name
Next Index
' Normalize the output pdf file name
If LCase(Right(PDFFilePath, 4))  ".pdf" Then PDFFilePath = PDFFilePath & ".pdf"
' Save the current active worksheet
Set OriginalActiveWorksheet = ActiveSheet
' Save the current sheet order
ReDim OriginalOrderNames(1 To ThisWorkbook.Sheets.Count)
For Index = 1 To ThisWorkbook.Sheets.Count
OriginalOrderNames(Index) = ThisWorkbook.Sheets(Index).Name
Next Index
' Reorder the worksheets
For Index = UBound(SheetsToPrint) To LBound(SheetsToPrint) Step -1
If ThisWorkbook.Sheets(SheetsToPrint(Index)).Index > 1 Then
ThisWorkbook.Sheets(SheetsToPrint(Index)).Move Before:=ThisWorkbook.Sheets(1)
End If
Next Index
' Print the worksheets
TempPFFilePathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "pf"
PDFLogPathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "log"
On Error Resume Next
Kill TempPFFilePathName
On Error GoTo 0
ThisWorkbook.Worksheets(SheetsToPrint).PrintOut ActivePrinter:="Adobe PDF", PrintToFile:= _
True, Collate:=True, PrToFilename:=TempPFFilePathName
' Restore the original worksheet order
For Index = 1 To ThisWorkbook.Sheets.Count
If ThisWorkbook.Sheets(OriginalOrderNames(Index)).Index  Index Then
ThisWorkbook.Sheets(OriginalOrderNames(Index)).Move Before:=ThisWorkbook.Sheets(Index)
End If
Next Index
' Restore the original active worksheet
OriginalActiveWorksheet.Activate
' Convert the postscript file to .pdf
Set PDFDistillerApplication = New PdfDistiller
Result = PDFDistillerApplication.FileToPDF(TempPFFilePathName, PDFFilePath, "")
On Error Resume Next
Kill TempPFFilePathName
If Result = 1 Then Kill PDFLogPathName
End Sub
Ich denke es fehlt der Makroname. Wenn ich aber z. B. Sub PDF_Print_Sheet() in die erste Zeile Schreibe, dann erwarter er ein End Sub , da ja in der ursprünglich ersten Zeile schon ein Sub steht.
Wenn das behoben wird, kommt aber sicher die nächste Fehlermeldung, da das Makro nicht für mich gemacht wurde.
Hat jemand Lust, Zeit und etwas Geduld, mir dabei zu helfen?
@Rainer - DANKE für die tolle Hilfe. Das Du keine Lust mehr hast verstehe ich.
Bis später und liebe Grüß
Sandra
Anzeige
Sub PDF_Print_Sheet()
10.02.2010 16:04:18
Sandra
Hallo zusammen,
vielleicht hat ja jemand eine Idee, warum dieses Makro bei mir nicht läuft:
Die aller erste Meldung die ich bei Versuch es auszuführen bekomme ist dies hier:
Userbild
Hier das Makro:
Public Sub PrintSheetsToPDF( _
ByVal SheetsToPrint As Variant, _
ByVal PDFFilePath As String _
)
' Print the specified sheets to a PDF file in the order specified. Requires
' Adobe Acrobat 7.0 and a reference to Acrobat Distiller.
' Syntax
' PrintSheetsToPDF(Sheets, PDFFilePath)
' SheetsToPrint - Array of sheet names to be printed. The sheets included are
'   sorted in that order and then printed in one print job. When the printing
'   is complete the original order is restored.
' PDFFilePath - Full path to the PDF file.
' Example
' Print sheets "Sheet4", "Sheet10", and "Sheet1" in that order:
'   PrintSheetsToPDF Array("Sheet4", "Sheet10", "Sheet1", "C:\Output.PDF")
Dim OriginalActiveWorksheet As Worksheet
Dim OriginalOrderNames As Variant
Dim Index As Long
Dim PDFDistillerApplication As PdfDistiller
Dim TempPFFilePathName As String
Dim PDFLogPathName As String
Dim Result As Long
' Normalize the sheet to print parameter
If Not IsArray(SheetsToPrint) Then SheetsToPrint = Array(SheetsToPrint)
For Index = LBound(SheetsToPrint) To UBound(SheetsToPrint)
If TypeName(SheetsToPrint(Index)) = "Worksheet" Then SheetsToPrint(Index) = SheetsToPrint( _
Index).Name
Next Index
' Normalize the output pdf file name
If LCase(Right(PDFFilePath, 4))  ".pdf" Then PDFFilePath = PDFFilePath & ".pdf"
' Save the current active worksheet
Set OriginalActiveWorksheet = ActiveSheet
' Save the current sheet order
ReDim OriginalOrderNames(1 To ThisWorkbook.Sheets.Count)
For Index = 1 To ThisWorkbook.Sheets.Count
OriginalOrderNames(Index) = ThisWorkbook.Sheets(Index).Name
Next Index
' Reorder the worksheets
For Index = UBound(SheetsToPrint) To LBound(SheetsToPrint) Step -1
If ThisWorkbook.Sheets(SheetsToPrint(Index)).Index > 1 Then
ThisWorkbook.Sheets(SheetsToPrint(Index)).Move Before:=ThisWorkbook.Sheets(1)
End If
Next Index
' Print the worksheets
TempPFFilePathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "pf"
PDFLogPathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "log"
On Error Resume Next
Kill TempPFFilePathName
On Error GoTo 0
ThisWorkbook.Worksheets(SheetsToPrint).PrintOut ActivePrinter:="Adobe PDF", PrintToFile:= _
True, Collate:=True, PrToFilename:=TempPFFilePathName
' Restore the original worksheet order
For Index = 1 To ThisWorkbook.Sheets.Count
If ThisWorkbook.Sheets(OriginalOrderNames(Index)).Index  Index Then
ThisWorkbook.Sheets(OriginalOrderNames(Index)).Move Before:=ThisWorkbook.Sheets(Index)
End If
Next Index
' Restore the original active worksheet
OriginalActiveWorksheet.Activate
' Convert the postscript file to .pdf
Set PDFDistillerApplication = New PdfDistiller
Result = PDFDistillerApplication.FileToPDF(TempPFFilePathName, PDFFilePath, "")
On Error Resume Next
Kill TempPFFilePathName
If Result = 1 Then Kill PDFLogPathName
End Sub
Ich denke es fehlt der Makroname. Wenn ich aber z. B. Sub PDF_Print_Sheet() in die erste Zeile Schreibe, dann erwarter er ein End Sub , da ja in der ursprünglich ersten Zeile schon ein Sub steht.
Wenn das behoben wird, kommt aber sicher die nächste Fehlermeldung, da das Makro nicht für mich gemacht wurde.
Hat jemand Lust, Zeit und etwas Geduld, mir dabei zu helfen?
@Rainer - DANKE für die tolle Hilfe. Das Du keine Lust mehr hast verstehe ich.
Bis später und liebe Grüß
Sandra
Anzeige
AW: Sub PDF_Print_Sheet()
10.02.2010 19:46:11
Hajo_Zi
Hallo Sandra,
das Makro erscheint nicht in dem Dialog das es zum Aufruf Werte braucht.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige