Hallo Peter,
(25.07.2019, 00:18)Käpt\n Blaubär schrieb: [ -> ]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 *.xls
m oder *.xls
b runterladen.
Gruß Uwe
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
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?
Hallo,
bezüglich des Wasserzeichens: Nein. Für das Sperren von Reiternamen: Schütze die Arbeitsmappe.