Office: (Office 2013) Getrennte Bereiche in PDF auf einer Seite

Hallo alle zusammen,

ich versuche aktuell mehrere Bereiche als PDF zu exportieren. Das klappt auch schön und gut, aber die Bereiche werden auf zwei verschiedene Seiten aufgetrennt. Wie kann ich beide Bereiche auf EINE Seite PDF exportieren?

Danke im Voraus für eure Hilfe!

Hier der Code:

Code:

Sub Druck()
Dim r1 As range
Dim r2 As range

Set r1 = range("B2:N4")
r1.Select
Set r2 = range("B7:N13")
r2.Select
Union(r1, r2).Select

Union(r1, r2).ExportAsFixedFormat xlTypePDF, Filename:=ThisWorkbook.Path & "\Anlage " & 123 & ".pdf", To:=1

End Sub

 

Hi,

kopiere beide Bereiche untereiander in ein leeres extra Tabellenblatt und exportiere dieses dann als PDF

Code:

Sub Druck()
    Union(Range("B2:N4"), Range("B7:N13")).Copy Worksheets("Tabelle2").Range("A1")
    Worksheets("Tabelle2").ExportAsFixedFormat xlTypePDF, _
        Filename:=ThisWorkbook.Path & "\Anlage " & 123 & ".pdf", To:=1
End Sub

Bis später,
Karin

 

Sorry für die späte Antwort, war krankheitsbedingt nicht in meiner Firma und habe deswegen nicht weiter am Projekt gearbeitet.
Vielen Dank erstmal Karin!
Wenn ich versuche, den Bereich zu kopieren, füllt er mir in den leeren Zellen Nullen auf und verrückt die reinen Zahlenwerte.
Hier der Code:

Code:

Private Function CreateAnlage(rRange As range, RGNr As Integer, KundenNr As Long)
Dim pdfWs As Worksheet
Set pdfWs = ThisWorkbook.Worksheets("PDF")

    pdfWs.Cells(1, 1).Value = "Kundennummer: " & KundenNr
    pdfWs.Cells(2, 1).Value = "Rechnungsnummer: 2020 - " & RGNr
    pdfWs.Cells(3, 1).Value = "Datum: " & Date
    pdfWs.Cells(5, 1).PasteSpecial Paste:=xlPasteColumnWidths, SkipBlanks:=True
    pdfWs.Cells(5, 1).Resize(rRange.Rows.Count, rRange.Columns.Count).Value = rRange.Value
    pdfWs.Activate

    With pdfWs.PageSetup
        .Zoom = False
        .Orientation = xlLandscape
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    pdfWs.ExportAsFixedFormat xlTypePDF, Filename:=ThisWorkbook.Path & "\Anlage " & RGNr & ".pdf"
    Application.DisplayAlerts = False
    Worksheets("PDF").Delete
    Application.DisplayAlerts = True

End Function

Ich habe es auch mit PasteSpecial versucht, bin alle Parameter durchgegangen, hat jedoch nicht funktioniert.
Gibts da eine Möglichkeit die Zellen exakt wie in der Quelldatei zu kopieren und einzufügen?

 

Wie man mit allen Zellformatierungen kopiert habe ich bereits geschrieben - du übergibst nur die Werte.

Bis später,
Karin

 

Die Zellenformatierung darf leider nicht mit übergeben werden, da die Quelldatei nur Formeln beinhaltet. Sonst sieht es so aus:

 

Code:

Private Function CreateAnlage(rRange As range, RGNr As Integer, KundenNr As Long)
Dim pdfWs As Worksheet
Set pdfWs = ThisWorkbook.Worksheets("PDF")

    pdfWs.Cells(1, 1).Value = "Kundennummer: " & KundenNr
    pdfWs.Cells(2, 1).Value = "Rechnungsnummer: 2020 - " & RGNr
    pdfWs.Cells(3, 1).Value = "Datum: " & Date
    rRange.Copy Destination:=pdfWs.Cells(5, 1)
    pdfWs.Cells(5, 1).PasteSpecial Paste:=xlPasteColumnWidths, SkipBlanks:=True
    pdfWs.Cells(5, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, SkipBlanks:=True
    pdfWs.Activate

    With pdfWs.PageSetup
        .Zoom = False
        .Orientation = xlLandscape
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    pdfWs.ExportAsFixedFormat xlTypePDF, Filename:=ThisWorkbook.Path & "\Anlage " & RGNr & ".pdf"
    Application.DisplayAlerts = False
    Worksheets("PDF").Delete
    Application.DisplayAlerts = True

End Function

Mit PasteSpecial Paste:= Paste:=xlPasteValuesAndNumberFormats funktioniert es leider auch nicht, kommt aber relativ nahe. Ich denke die Zellenformatierung kann ich programmatisch korrigieren. Aber das mit den Nullen ist sehr störend und lässt sich nicht so einfach korrigieren leider. Denn jede Zelle, die leer ist, füllt er mit Nullen auf..

 

Was hat die Zellformatierung damit zu tun, dass die Zellen Formeln enthalten????
Übergib zuerst mittels PasteSpecial die Werte und anschließend die Formate

Code:

.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats

Bis später,
Karin