Drucken in Abhängigkeit von Bereichen

[Kuwer]

Hallo Peter,

Du hast uns in Deinem Post eine *.xlsx-Datei gezeigt.

der Code stand ja aber zusätzlich im Beitrag! Es soll ja auch Leute geben, die keine *.xlsm oder *.xlsb runterladen.

Gruß Uwe

[Steffl]

Hallo,

das dein letzter Versuch nicht geht, ist klar, da zum Beispiel die Orientation-Eigenschaft nicht eine Eigenschaft des Worksheet-Objekt ist, sondern vom PageSetup.

Code:

Sub prcDrucken()
   Dim lngC As Long
  
   For lngC = 2 To 28
      With Worksheets(lngC)
         Select Case lngC
            Case 2 To 4
               With .PageSetup
                  .Orientation = xlPortrait
                  .FitToPagesWide = 1
                  .Zoom = False
                  .PrintArea = "$A$1:$E$43"
               End With
               .PrintOut Copies:=1
            Case 5 To 8
               If WorksheetFunction.CountA(.Range("A23:D44")) Then
                  With .PageSetup
                     .Orientation = xlPortrait
                     .FitToPagesWide = 1
                     .Zoom = False
                     .PrintArea = "$A$1:$D$51"
                  End With
                  .PrintOut Copies:=1
               End If
               If WorksheetFunction.CountA(.Range("D3:D19"), .Range("A23:D44")) Then
                  .PageSetup.PrintArea = "$A$100:$D$151"
                  .PrintOut Copies:=2
               End If
            Case 9 To 28
               If WorksheetFunction.CountA(.Range("A23:D44")) Then
                  With .PageSetup
                     .Orientation = xlPortrait
                     .FitToPagesWide = 1
                     .Zoom = False
                     .PrintArea = "$A$1:$D$150"
                  End With
                  .PrintOut Copies:=1
                  If WorksheetFunction.CountA(.Range("A1:D51")) Then
                     .PageSetup.PrintArea = "$A$100:$D$150"
                     .PrintOut Copies:=2
                  End If
               End If
         End Select
      End With
   Next lngC

End Sub

[Stoffo]

Hallo Stefan,

vielen Dank. Das scheint die Lösung zu sein  :23: hast du zufällig auch ne Lösung bzgl. einer automatischen Größenanpassung des Wasserzeichens oder des Sperrens von Reiternamen sowie des hinzufügens dieser parat?

[Steffl]

Hallo,

bezüglich des Wasserzeichens: Nein. Für das Sperren von Reiternamen: Schütze die Arbeitsmappe.