Druckbereich mit VBA

[gbw-99]

Hallo Spezialisten
möchte gerne per VBA den Druckbereich bestimmen, jeweils von Spalte A bis und mit L.
Die erste Setie geht von Zeile 1 bis und mit Zeile 27
Ab der 2. Seite und nachfolgenden Seiten immer im Abstand von 29 Zeilen
(2. Seite bei 56, 3. Seite bei 85, 4. Seite bei 114 usw. ....und dies bis zum letzten Texteintrag in Spalte A (Alles was noch dem letzten Texteintrag kommt soll gelöscht werden)
Zudem muss jede Seite dann auf das Format auf A4 Quer vertikal und horizontal eingemittet sein.
Bischen viel auf einmal - aber das wird für den einen oder anderen sicherlich ein Klacks sein.
Danke im voraus
Gruss Norbert

[schauan]

Hallo Norbert,

kennst Du den Makrorekorder? Die Aufgabe sollte damit größtenteils lösbar sein.
Lediglich in einem Punkt müsste man eingreifen - was das Ende betrifft: Alles was noch dem letzten Texteintrag kommt soll gelöscht werden.
Da ist nur die Frage, wie man den genauer definiert. Der letzte unabhängig von Spalte A bis L oder der letzte in einer bestimmten Spalte oder …

[gbw-99]

Hallo
Makrorekorder kenne ich - da kriege ich nichts gescheites raus..

Gemeint ist nach dem letzten Texteintrag in Spalte A, danach soll alles gelöscht werden.
Ich habe für jeden Daternsatz eine Seite reserviert, es können schlussendlich bis zu 1500 Seiten entstehen.

[schauan]

Hallöchen,

aufgezeichnet bekommt man z.B. das für die ersten beiden Umbrüche:

Code:

Sub Makro1()
'
' Makro1 Makro
'

'
    ActiveWindow.SmallScroll Down:=9
    Rows("27:27").Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    ActiveWindow.SmallScroll Down:=24
    Application.Left = 424
    Application.Top = 155.5
    ActiveWindow.SmallScroll Down:=6
    Rows("56:56").Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End Sub

das kann man erst mal auf das wesentliche das Einfügen der Umbrüche - einkürzen

Code:

Sub Makro1()
    Rows("27").Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    Rows("56").Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End Sub

Das könnte man nun bis zur Zeile 1500 so fortsetzen - bzw hier käme der erste Eingriff - eine Schleife

Code:

Sub Makro1()
'Variablendeklarationen
Dim iCnt%
    'Ersten Zeilenumbruch setzen
    Rows("27").Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    'weitere Umbrueche ab Zeile 56, alle 29 Zeilen setzen
    For icnt=56 to 1500 step 29
      Rows("56").Select
      ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    'Ende weitere Umbrueche ab Zeile 56, alle 29 Zeilen setzen
    Next
End Sub

Bei mir kommt jetzt erst mal ein TimeOut - Abendbrot

[schauan]

Hallöchen,

so, jetzt der nächste Stand. Ich lösche jetzt alles nach dem letzten Eintrag in Spalte A. Wenn nach dem letzten Text noch Zahlen kommen werden die mit diesem Code nicht gelöscht. Wenn die weg sollen, müsste man noch auf den Unterschied Text / Zahl prüfen.

Code:

Sub Makro1()
'Variablendeklarationen
Dim iCnt%, iLastRow%
'letzte Zelle feststellen
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Daten darunter loeschen
Rows(iLastRow + 1 & ":" & Rows.Count).Clear
'Druckbereich festlegen
ActiveSheet.PageSetup.PrintArea = Range("A1:L" & iLastRow)
'Ersten Zeilenumbruch setzen
Rows("27").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
'weitere Umbrueche ab Zeile 56, alle 29 Zeilen setzen
For iCnt = 56 To iLastRow Step 29
  Rows(iCnt).Select
  ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
'Ende weitere Umbrueche ab Zeile 56, alle 29 Zeilen setzen
Next
End Sub

[gbw-99]

Hallo André
Makro bleibt hier immer hängen:

ActiveSheet.PageSetup.PrintArea = Range("A1:L" & iLastRow)

Woran liegt das?
Gruss Norbert

[schauan]

Hallo Norbert,

kommt eine Fehlermeldung? Bei mir läuft es durch, macht aber nix
Es fehlt am Ende der Zeile was:
ActiveSheet.PageSetup.PrintArea = Range("A1:L" & iLastRow).Address

[gbw-99]

Hallo André
passt - besten Dank
Gruss Norbert