Ausgewählte Sheets in ein PDF zusammenfassen

Computer: Software & Programmierung Visual Basic
#1

Hallo gemeinsam,

ich suche nach einer Möglichkeit ausgewählte Sheets in ein einziges Pdf-Ausdruck zusammenzufassen. Irgendwie gelingt es mit nicht wirklich.

Ich habe in Tabellenblatt1 und in Tabellenblat3 Druckbereiche festgestellt und jetzt würd ich gern mit einem Button diese zwei Druckbreiche in ein Pdf-Dokument zusammenfassen.

Der Code:
Sub PDF()
Sheets(„Tabelle1“).Select
Sheets(„Tabelle3“).Select
Application.ActivePrinter = „PDFCreator auf Ne00:“
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
„PDFCreator auf Ne00:“, Collate:=True
End Sub

erzeugt nur von dem Tabellenblatt3 ein pdf. Und wenn ich statt ActiveWindow -> ActiveWorkbook nehme dann druckt er alle Tabellenblätter. Ich will aber nur den Druckbereich von Tabelle 1 + 3 haben… :-S

Hat vielleicht jemand eine Lösung?

Vielen Dank… :smile:

Gruss,D.

#2

Hallo Dimi,

ich suche nach einer Möglichkeit ausgewählte Sheets in ein
einziges Pdf-Ausdruck zusammenzufassen. Irgendwie gelingt es
mit nicht wirklich.

vergiss select und window, braucht man nur seltenst.

Sub PDF()
Dim Merker As String
Merker = Application.ActivePrinter
Application.ActivePrinter = "PDFCreator auf Ne00:"
Worksheets(Array("Tabelle1", "Tabelle3")).PrintOut
Application.ActivePrinter = Merker
End Sub

Gruß
Reinhard

#3

Hallo Reinhard,

hab heute dein Code ausprobiert und er funktioniert einwandfrei. Vielen Dank dafür. :smile:

Mich interessiert in dem Zusammenhang noch etwas.
Ich wollte einen Button einsetzen welcher mir die beiden Tabellenblätter(also 1 und 3) separat auf eine neue Excel Datei (‚Tabelle1!D3‘.xls) kopiert und diese dann automatisch in Outlook als Anhang einfügt. Die neue Datei brauch nicht auf dem PC gespeichert werden.

Zuvor müsste natürlich eine neue Mail per Outlook gestartet werden.

Könnte mann das in einem Button bzw. Vorgang realisieren? Allerdings müsste man die Werte der beiden Tabellen kopieren und nicht die Blätter selbst, weil diese mit Formeln erzeugt wurden.

Und um das noch komplizierter zu machen würde ich gerne noch in der neuen Mail die aktuelle Signatur einfügen wollen und vielleicht noch einen Text.
„Hallo zusammen, anbei die Datei für ‚Tabelle1!D3‘ . Vielen Dank.“

Verlange ich jetzt was unmögliches? :-/

Besten Dank und Gruß. :smile:

PS: In ‚Tabelle1!D3‘ steht der Name für den die Tabelle bestimmt ist.

#4

Neue Mappe als Mail Anhang mit Outlook senden
Hallo Dimi,

k.A. warum, in OL kann ich mit vbCRLF keine Zeilen umbrechen, es geht um die Codestelle wo jetzt Chr(19) steht.
Anscheinend läuft der Code in XL2000.

Gruß
Reinhard

Option Explicit

Sub MappeSenden()
Dim Datei As String, strTo As String, strCC As String, strBCC As String
Dim strbetreff As String, strText As String
Const Pfad As String = "c:\test\"
With ThisWorkbook
 Datei = "TabelleD1.xls"
 .Worksheets("Tabelle1").Copy
 .Worksheets("Tabelle2").Copy After:=ActiveWorkbook.Worksheets(1)
 ActiveWorkbook.SaveAs Pfad & Datei
 Workbooks(Datei).Close savechanges:=True
 strTo = .Worksheets("Tabelle1").Range("D1").Value
 'strCC = "[email protected],dugmx.de"
 'strBCC = "[email protected],[email protected]"
 strbetreff = "Datei " & Datei & " vom " & Format(Date, "dd.mm.yyyy")
 strText = "Hallo zusammen, anbei die Datei für "
 strText = strText & .Worksheets("Tabelle1").Range("D1").Value & "."
 strText = strText & Chr(10) & "Vielen Dank."
 Call Mailen(Pfad & Datei, strTo, strbetreff, strText)
End With
'Kill Pfad & Datei
End Sub

Sub Mailen(ByVal aws As String, ByVal strTo As String, ByVal strbetreff As String, ByVal strText As String, \_
Optional ByVal strCC As String = "", Optional ByVal strBCC As String = "")
Application.DisplayAlerts = False
Dim olapp As Object
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
 .To = strTo
 .Subject = strbetreff
 .HtmlBody = strText
 '.ReadReceiptRequested = True 'optional Lesebestätigung anfordern
 .Attachments.Add aws
 .Display
 '.send
End With
Set olapp = Nothing
Application.DisplayAlerts = True
End Sub
1 Like
#5

Hallo Reinhard,

also ich bin dermassen beeindruckt wie man so schnell einen lauffähigen Code „herzaubern“ kann. Kompliment! :smile:

Gerne würde ich noch drei Änderungen hinzufügen:
Könnte mann bei der Zeile:Const Pfad As String = „c:\test“
auch: „c:\Dokumente und Einstellungen_ ziehe Computernamen _\Desktop“ eingeben? Dann hat man die neue Datei immer auf dem Desktop. :smile:

Zwei Zeilen drunter sollte er eigentlich den Dateinamen aus Tabelle1 Zelle D1 ziehen. Ginge das noch? Also wenn in Tabelle1 Zelle D1 „Meier“ steht dann soll die Datei „Meier.xls“ heissen.

Und die dritte Bitte wäre das er auch noch die Signatur miteinbezieht (aus Extras/Optionen/E-Mail-Format/Signaturen).

Der Zeilnumbruch scheint wohl nicht zu klappen, aber ich kann auch so gut damit leben :smile:

Besten Dank nochmal.
Gruss.