Seitenumbrüche für Druck optimieren

[RudiB]

Liebes Forum, 

ich bin neu hier und wende mich gleich mit einem Problem an euch, das ich mit meinen üblichen Ansätzen - Google und ChatGPT - nicht lösen konnte. 

Ich habe ein Excel-Programm geschrieben, bei dem als Ergebnis ein 13-seitiges Dokument als PDF erstellt werden kann. Der Druckbereich wird dynamisch festgelegt, da nicht jede der 13 Seiten immer notwendig ist. Das passiert, wenn der Benutzer die das Marko zum PDF-Speichern auslöst. 

Beim Seitenlayout habe ich bei der Größe festgelegt: 
- Breite: 1 Seite
- Höhe: automatisch
Zusätzlich habe ich manuelle Seitenumbrüche eingefügt. 

Auf meinem PC funktioniert das auch tadellos. Das Problem: Auf anderen PCs mit anderen Bildschirmauflösungen wird die Seite insgesamt höher. Dadurch fügt Excel einen automatischen Seitenumbruch vor meinem manuellen ein. Die Folge: Es werden etliche Seiten gedruckt, die leer sind bzw. bei denen in der ersten Zeile jener Inhalt steht, der eigentlich in der letzten Zeile der vorigen Seite stehen sollte. 

Habt ihr einen Tipp, wie ich dieses Problem lösen kann?

Danke und LG

Rudi

PS: Hier noch die Makros zum Druckbereich/Speichern: 


Sub SaveAsPDF()
    Dim ws As Worksheet
    Dim pdfName As String
    Dim pdfPath As String
    Dim msgResponse As Integer

    ' Druckbereich anpassen
    SetDynamicPrintArea
   
    ' Definieren Sie das Tabellenblatt "Vergleich"
    Set ws = ThisWorkbook.Sheets("Vergleich")
   
    ' PDF-Name aus dem Wert in Zelle E4 des Tabellenblatts "Vergleich" generieren
    pdfName = ws.Range("pdfname").value

    ' Definieren Sie den Speicherpfad (z.B. auf dem Desktop). Sie können diesen Pfad ändern.
    pdfPath = ThisWorkbook.Path & "\" & pdfName
   
    ' Überprüfen, ob die Datei bereits existiert
    If Dir(pdfPath) <> "" Then
        msgResponse = MsgBox("Die Datei existiert bereits. Möchten Sie sie überschreiben?", vbYesNo + vbExclamation, "Datei existiert")
        If msgResponse = vbNo Then Exit Sub 'Wenn "Nein" ausgewählt wird, beende das Makro
    End If

    ' Tabellenblatt "Vergleich" als PDF speichern
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    MsgBox "PDF wurde gespeichert unter: " & pdfPath
End Sub

Sub SetDynamicPrintArea()
    Dim ws As Worksheet
    Dim printWs As Worksheet
    Dim printArea As String
   
    ' Setze das Arbeitsblatt, in dem der Druckbereich eingestellt wird
    Set ws = ThisWorkbook.Sheets("Vergleich")
   
    ' Setze das Arbeitsblatt, in dem die Zelle "druckbereich" definiert ist
    Set printWs = ThisWorkbook.Sheets("Druck")
   
    ' Lese den Wert aus der Zelle, die den Druckbereich enthält
    printArea = printWs.Range("druckbereich").value
   
    ' Setze den Druckbereich
    ws.PageSetup.printArea = printArea
End Sub

[RudiB]

Nachdem ich 3 Stunden mit Chat GPT an einem Code gearbeitet hatte, habe ich eine funktionierende Lösung gefunden. 

Ein Loop, der mit 60 % Skalierung beginnt, dann die Seitenumbrüche zählt um die Druckseitenzahl zu bestimmen und mit der gewünschten Zahl vergleicht, dann die Skalierung um 1 % senkt, die Druckvorschau öffnet, damit sich die Seitenzahlen updaten und wieder um 1 % reduziert - so lange, bis die gewünschte Seitenzahl erreicht wird.

Dann bin ich draufgekommen, dass die Standardlösung von Excel - nämlich beim Seitenlayout auf 1 Seite breit und 1 Seite hoch zu stellen - mit manuellen Seitenumbrüchen nicht umgehen kann und ich stattdessen einfach zwischen jedem Blatt eine Leerzeile einfügen muss, die nicht Teil des Druckbereich ist. 

So kann man auch 3 h vergeuden