Immer gerade Seitenzahl drucken
28.10.2013 09:11:43
Sebastian
ich komme mit meinem Makro leider nicht weiter.
Mein Makro soll die Seitenzahl prüfen und wenn diese ungerade ist, einen Seitenumbruch am Ende einfügen. Aus dieser Datei wird ein PDF gedruck und daraus dann per Dublex auf Papier gedruckt. Mein Makro ist teils selbst geschrieben, teils zusammen Kopiert (Ist nicht perfekt, aber es klappt). Für ein einzelnes Tabellenblatt funktioniert es auch super. Will ich es aber auf alle Tabellenblätter ein mal anwenden, klapt es nicht mehr. Ich bekomme immer eine Fehlermeldung für diese Zeiele:
d = Range(ActiveSheet.PageSetup.PrintArea).Cells(Range(ActiveSheet.PageSetup.PrintArea).Cells.Count).Column
(Ermitteln der alten Spaltenbreite, da diese beibehalten warden soll; Ist Variabel)
Hier mein Makro:
Public Sub DuplexDrucken()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
ws.active
Dim nHBreaks As Integer
Dim nVBreaks As Integer
Dim nHPages As Integer
Dim nVPages As Integer
Dim nPagesTot As Integer
Dim Zelle As Range
Dim Spalte As Integer
'--------------------------------------------Seiten Zählen
If TypeName(ActiveWorkbook.ActiveSheet) = "Worksheet" Then
With ActiveWorkbook.ActiveSheet
nHBreaks = .HPageBreaks.Count
nHPages = nHBreaks + 1
nVBreaks = .VPageBreaks.Count
nVPages = nVBreaks + 1
nPagesTot = nHPages * nVPages
End With
'---------------------------------------------Gerade oder Ungerade
If nPagesTot Mod 2 0 Then
For Each Zelle In ActiveSheet.Range("A1:A1000").Cells 'Nach ,., suchen
If Zelle.Text = ",.," Then ',., Steht auf jedem TB ganz unten
Zelle.Activate
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell ' Seitenumbruch _
_
_
_
_
einfügen
Exit For
End If
Next
Spalte = ActiveCell.Row
d = Range(ActiveSheet.PageSetup.PrintArea).Cells(Range(ActiveSheet. _
PageSetup.PrintArea).Cells.Count).Column
Bereich = Cells(Spalte, d).Address(RowAbsolute:=False, ColumnAbsolute:=False)
ActiveSheet.PageSetup.PrintArea = "$A$1:" & Bereich
Range("A1").Select
Else
End If
Else
MsgBox "Das aktive Blatt ist kein Tabellenblatt!", _
vbOKOnly + vbInformation
End If
Next ws
End Sub
Wer kann mir bitte weiterhelfen.
Vielen Dank
Liebe Grüße Sebatian