drucken als pdf

Question

Servus,
Ich möchte aus einer Excel Mappe 2-5 Tabellenblätter in einer pdf exportieren. Und zwar jeweils nur Teilbereiche (quasi druckbereiche). Dafür habe ich folgendes Makro geschrieben:

Sub pdf_drucken()
Dim IntZeilenZahl, i As Integer
Dim BoBlatt7, BoBlatt8, BoBlatt9, BoBlatt10 As Boolean
Dim StrPfad, StrName, StrBereich As String
Dim wks6, wks7, wks8, wks9, wks10 As Object

Call Anfang
BoBlatt7 = False
BoBlatt8 = False
BoBlatt9 = False
BoBlatt10 = False
StrBereich = ""
StrPfad = ActiveWorkbook.Path
StrName = ActiveWorkbook.Name

For i = 6 To 10
IntZeilenZahl = Sheets(i).Cells(Rows.Count, 3).End(xlUp).Row
If IntZeilenZahl > 9 Then
With Sheets(i).PageSetup
.PrintArea = "A1:G" & IntZeilenZahl
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
End With
Select Case i
Case Is = 7
BoBlatt7 = True
Case Is = 8
BoBlatt8 = True
Case Is = 9
BoBlatt9 = True
Case Is = 10
BoBlatt10 = True
Case Else
GoTo Fehler
End Select
End If
Next i

Set wks6 = Sheets(6) 'StrBereich = Chr(34) & Sheets(6).Name & Chr(34)
If BoBlatt7 = True Then Set wks7 = Sheets(7) 'StrBereich = StrBereich & ", " & Chr(34) & Sheets(7).Name & Chr(34)
If BoBlatt8 = True Then Set wks8 = Sheets(8) 'StrBereich = StrBereich & ", " & Chr(34) & Sheets(8).Name & Chr(34)
If BoBlatt9 = True Then Set wks9 = Sheets(9) 'StrBereich = StrBereich & ", " & Chr(34) & Sheets(9).Name & Chr(34)
If BoBlatt10 = True Then Set wks10 = Sheets(10) 'StrBereich = StrBereich & ", " & Chr(34) & Sheets(10).Name & Chr(34)

'msgbox StrBereich
With Sheets(Array(wks6, wks7, wks8, wks9, wks10))
.ExportAsFixedFormat , _
Type:=xlTypePDF, _
Filname:=StrPfad & StrName & ".pdf", _
Quality:=xlQualityStandard, _
ignoreprintareas:=False, _
openafterpublish:=True
End With

Ich bekomme jedesmal in der Zeile "with Sheets(Array(wks6, wks7...))" sie Fehlermeldung: Laufzeitfehler 9, index außerhalb des gültigen bereichs. Ich habe auch schon versucht die Tabellenblattnamen in einer Stringvariablen darzustellen und diese anstelle von wks6-10 einzufügen( also "Sheets(Array(strbereich))) -siehe kommentarzeilen-mit der gleichen Fehlermeldung.

Kann mir jemand sagen wie das besser funktioniert?

Zum Thema "als pdf Drucken": Kann das so funktionieren oder habe ich in meiner Unwissenheit wieder etwas falsch gemacht? (Es soll sich nur noch die "speichern unter" Meldung öffnen, mit dem Namen und Pfad der aktuellen Excel Datei und dem Dateityp pdf Voreingestellt)

liebe Grüße & herzlichen Dank schonmal
SirSolaris

Answer 1

Warum greifst du nicht auf eine fertige Lösung wie z.b. "PDF-Creator" zurück.
Das wird installiert und lässt sich dann als Drucker auswählen.

Answer 2

Hallo,
Weil das als Teil eines größeren Makros auf "Knopfdruck" eine PDF erstellen soll - so die Vorgabe. Und weil das von einem größeren Personenkreis genutzt werden soll und daher Idiotensicher und einheitlich gestaltet werden muss.
lg

Answer 3

Hallo,

schau mal, ob das Makro so klappt, wie du dir das vorstellst:

Sub pdf_drucken()
Dim IntZeilenZahl, i As Integer
Dim BoBlatt7, BoBlatt8, BoBlatt9, BoBlatt10 As Boolean
Dim StrDatei, StrBereich As String
Dim varFilename As Variant

Call Anfang
BoBlatt7 = False
BoBlatt8 = False
BoBlatt9 = False
BoBlatt10 = False
StrBereich = ""

'Name und Ausgabepfad in Variable schreiben, ohne Excel-Endung .xlsm o.ä.
StrDatei = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & ".pdf"

For i = 6 To 10
IntZeilenZahl = Sheets(i).Cells(Rows.Count, 3).End(xlUp).Row
If IntZeilenZahl > 9 Then
With Sheets(i).PageSetup
.PrintArea = "A1:G" & IntZeilenZahl
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
End With
Select Case i
Case Is = 7
BoBlatt7 = True
Case Is = 8
BoBlatt8 = True
Case Is = 9
BoBlatt9 = True
Case Is = 10
BoBlatt10 = True
Case Else
GoTo Fehler
End Select
End If
Next i

'Hier werden die ausgewählten Tabellenblätter in Variable geschrieben, getrennt durch Komma
StrBereich = StrBereich & ThisWorkbook.Worksheets(6).Name & ","
If BoBlatt7 = True Then StrBereich = StrBereich & ThisWorkbook.Worksheets(7).Name & ","
If BoBlatt8 = True Then StrBereich = StrBereich & ThisWorkbook.Worksheets(8).Name & ","
If BoBlatt9 = True Then StrBereich = StrBereich & ThisWorkbook.Worksheets(9).Name & ","
If BoBlatt10 = True Then StrBereich = StrBereich & ThisWorkbook.Worksheets(10).Name & ","

'letztes Komma abschneiden
StrBereich = Left(StrBereich, Len(StrBereich) - 1)

'nun die ausgewählten Tabellenblätter selektieren
ThisWorkbook.Worksheets(Split(StrBereich, ",")).Select

'Speichern-unter-Dialog aufrufen und falls Dateiname nicht leer, dann speichern
varFilename = Application.GetSaveAsFilename( _
InitialFileName:=StrDatei, _
FileFilter:="PDF (*.pdf), *.pdf", _
Title:="als PDF speichern")

If varFilename <> False Then
ThisWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=varFilename
End If

End Sub

Gruß

M.O.

Answer 4

Hallo,

noch mal ich ;.). Hier noch etwas optimiert:

Sub pdf_drucken()
Dim IntZeilenZahl, i As Integer
Dim StrDatei, StrBereich As String
Dim varFilename As Variant

Call anfang

StrBereich = StrBereich & ThisWorkbook.Worksheets(6).Name & ","

'Name und Ausgabepfad in Variable schreiben, ohne Excel-Endung .xlsm o.ä.
StrDatei = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & ".pdf"

For i = 6 To 10
IntZeilenZahl = Sheets(i).Cells(Rows.Count, 3).End(xlUp).Row
If IntZeilenZahl > 9 Then
With Sheets(i).PageSetup
.PrintArea = "A1:G" & IntZeilenZahl
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
End With

StrBereich = StrBereich & ThisWorkbook.Worksheets(i).Name & ","

End If
Next i

'letztes Komma abschneiden
StrBereich = Left(StrBereich, Len(StrBereich) - 1)

'nun die ausgewählten Tabellenblätter selektieren
ThisWorkbook.Worksheets(Split(StrBereich, ",")).Select

'Speichern-unter-Dialog aufrufen und falls Dateiname nicht leer, dann speichern
varFilename = Application.GetSaveAsFilename( _
InitialFileName:=StrDatei, _
FileFilter:="PDF (*.pdf), *.pdf", _
Title:="als PDF speichern")

If varFilename <> False Then
ThisWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=varFilename
End If

End Sub

Gruß

M.O.

Answer 5

Hallo,

noch etwas geändert ;-):

Sub pdf_drucken()
Dim IntZeilenZahl, i As Integer
Dim StrDatei, StrBereich As String
Dim varFilename As Variant

Call anfang

StrBereich = StrBereich & ThisWorkbook.Worksheets(6).Name & ","

'Name und Ausgabepfad in Variable schreiben, ohne Excel-Endung .xlsm o.ä.
StrDatei = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & ".pdf"

For i = 6 To 10
IntZeilenZahl = Sheets(i).Cells(Rows.Count, 3).End(xlUp).Row
If IntZeilenZahl > 9 Then
With Sheets(i).PageSetup
.PrintArea = "A1:G" & IntZeilenZahl
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
End With
If i > 7 Then StrBereich = StrBereich & ThisWorkbook.Worksheets(i).Name & ","
End If
Next i

'letztes Komma abschneiden
StrBereich = Left(StrBereich, Len(StrBereich) - 1)

'nun die ausgewählten Tabellenblätter selektieren
ThisWorkbook.Worksheets(Split(StrBereich, ",")).Select

'Speichern-unter-Dialog aufrufen und falls Dateiname nicht leer, dann speichern
varFilename = Application.GetSaveAsFilename( _
InitialFileName:=StrDatei, _
FileFilter:="PDF (*.pdf), *.pdf", _
Title:="als PDF speichern")

If varFilename <> False Then
ThisWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=varFilename
End If

End Sub

Gruß

M.O.

Answer 6

Hi M.O.,
Danke schonmal,
Das funktioniert schonmal besser als meines ;)
Allerdings wird so wie du es geschrieben hast die gesamte Arbeitsmappe (Also auch die Tabellenblätter 1-5) kopiert und bei den Tabellenblättern 6-10 die Druckbereiche ignoriert
Ich habe dann

ThisWorkbook.ExportAsFixedFormat

durch

Selection.ExportAsFixedFormat [code] ersetzt und versucht

PrintAreas:=True[/code] bzw. [code]IgnorePrintAreas:=False[quote] einzufügen.

Ohne "PrintArea" Speichert er nur 4 weiße Blätter in der Pdf

Mit der PrintArea gibt er folgenden Fehler aus:
Laufzeitfehler 1004 Anwendungs oder objektdefinierter Fehler


Hättest du dazu noch eine Idee?

lg SirSolaris

Answer 7

Hallo,

da hab ich beim Test wohl etwas geschluddert :-(.

Das folgende Makro funktioniert bei mir jetzt einwandfrei. Es werden nur die ausgewählten Tabellenblätter als PDF ausgegeben und auch der Druckbereich wird berücksichtigt:

Sub pdf_drucken()
Dim IntZeilenZahl, i As Integer
Dim StrDatei, StrBereich As String
Dim varFilename As Variant

Call anfang

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

StrBereich = StrBereich & ThisWorkbook.Worksheets(6).Name & ","

'Name und Ausgabepfad in Variable schreiben, ohne Excel-Endung .xlsm o.ä.
StrDatei = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & ".pdf"

For i = 6 To 10
IntZeilenZahl = ThisWorkbook.Worksheets(i).Cells(Rows.Count, 3).End(xlUp).Row
If IntZeilenZahl > 9 Then
With ThisWorkbook.Worksheets(i).PageSetup
.PrintArea = "A1:G" & IntZeilenZahl
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
End With
If i > 6 Then StrBereich = StrBereich & ThisWorkbook.Worksheets(i).Name & ","
End If
Next i

'letztes Komma abschneiden
StrBereich = Left(StrBereich, Len(StrBereich) - 1)

'nun die ausgewählten Tabellenblätter selektieren und in neue Mappe kopieren
ThisWorkbook.Worksheets(Split(StrBereich, ",")).Copy

'Speichern-unter-Dialog aufrufen und falls Dateiname nicht leer, dann speichern
varFilename = Application.GetSaveAsFilename( _
InitialFileName:=StrDatei, _
FileFilter:="PDF (*.pdf), *.pdf", _
Title:="als PDF speichern")

If varFilename <> False Then
ActiveWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=varFilename
End If

'neues Workbook wieder schließen, ohne zu speichern
ActiveWorkbook.Close (False)

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Wie du siehst, werden die entsprechenden Tabellenblätter hilfsweise in ein neues Workbook kopiert, das dann als PDF gespeichert und wieder geschlossen wird.

Gruß

M.O.

Answer 8

Prima M.O. Danke!

Ich habe noch die Bildschirmaktualisierung raus, Die ist bei mir im Sub Anfang, bzw. Ende drin. und dann habe ich noch die Print Area bis Fit to Pages Wide für Sheet(6) eingegeben.

Jetzt funktioniert es Einwandfrei!

Vielen vielen Dank!

Es ist echt klasse zu sehen dass es noch so hilfsbereite Menschen gibt!

Falls ich mich irgendwie erkenntlich zeigen kann sag bescheid!

Answer 9

Eine Frage habe ich doch noch:
In der PDF erscheint oben Links der Schriftzug "Test". In der Erstellten Excel Datei taucht er nicht auf (Ich habe versuchsweise das löschen auskommentiert).
Wenn ich aus dieser oder der 1. Datei Manuell eine ExcelDatei erstelle taucht er ebenso auf. Bei anderen Arbeitsmappen nicht.
Weißt du zufällig wo das herkommt?
lg
SirSolaris

Answer 10

Hallo,

freut mich dass es jetzt klappt. Hast du in der Datei, in der Test auftaucht, eventuell Überschriften in den Tabellen drin (z.B. Name der Datei) oder ähnliches?

Vom Makro sollte er nicht kommen, dann müsste der Name bei allen Datein auftauchen.

Gruß

M.O.