Excel vba Variable Druckbereiche

[sharky51]

Hallo zusammen,

darf ich Euch wieder einmal um Eure werte Hilfe bitten?

Es soll im Querformat eine sich stetig veränderte Tabelle ausgedruckt werden. Die Tabelle hat 4 Zeilen als Headder und dieser soll auch auf allen Druckseiten erscheinen.
Dabei kann sich die Tabelle von der Zeilenanzahl her mal verkürzen oder es können viele Zeilen hinzukommen.
Es werden Daten über mehrere Spalten (A-O) eingetragen.
Tabelle kann auch ausgeblendete Zeilen enthalten.....also nur sichtbare Zeilen sollen ausgedruckt werden.

Die unterschiedlichen Datensätze sind durch eine Leerzeile und einer weiteren, farblich "blauen" (als Überschrift) Zeile vom vorhergehenden Datensatz getrennt.
Um jetzt einen strukturierten Ausdruck zu bekommen soll
a) die jede Druckseite optimal ausgenutzt werden aber
b) ein Datenblock soll durch den Seitenwechsel nicht zerstückelt werden.

Wie kann man das mittels vba-Code umsetzen?
Das Makro soll erkennen, ups... die Druckseite reicht für eine zusammenhängende Darstellung nicht aus, also generiere ich einen Seitenumbruch und schreibe ab da den Rest der Daten.....und das soll natürlich für alle Druckseiten gelten.

Hier mal ein Beispiel für den Aufbau der Tabelle in der Anlage.

Wäre schön, wenn Ihr mir da helfen könntet.

[schauan]

Hallöchen,

schaue mal, dass Du die jeweiligen "Abschnittsenden" irgendwie markierst. Ich hatte hier mal einen Ansatz, wo ich das mit "AS" gemacht habe.

Code:

Sub ZeilenUmbruchSetzen()
'Variablendeklarationen
'Integer
Dim iCnt%, iFoundRow%
'Mit dem Blatt 1
With Worksheets(1)
    'Seitenumbrueche zuruecksetzen
    .ResetAllPageBreaks
    'Zaehler fuer Seitenumbrueche setzen
    iCnt = 1
    'Erste Fundstelle ermitteln
    Set c = .Columns(1).Find(What:="AS", After:=.Cells(1, 1), _
              LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext)
    'Wenn etwas gefunden wurde, dann
    If Not c Is Nothing Then
        'erste Fundstelle merken
        firstaddress = c.Address
        'Zeilennummer merken
        iFoundRow = c.Row
        'Schleife ueber alle Treffer
        Do
           'Wenn die Treffezeile unter der Umbruchzeile leigt, dann
           If c.Row > .HPageBreaks(iCnt).Location.Row Then
                'Seitenumbruch vor letztes WSC einfuegen
                .HPageBreaks.Add before:=Cells(iFoundRow, 1)
                'Zaehler hochsetzen
                iCnt = iCnt + 1
           'Ende Wenn die Treffezeile unter der Umbruchzeile leigt, dann
            End If
            'Trefferzeile merken
            iFoundRow = c.Row
            'naechsten Treffer suchen
            Set c = .Columns(1).FindNext(c)
        'Ende Schleife ueber alle Treffer
        Loop While Not c Is Nothing And c.Address <> firstaddress And .HPageBreaks.Count >= iCnt
    'Ende Wenn etwas gefunden wurde, dann
    End If
'Mit dem Blatt 1
End With
End Sub

[sharky51]

Hallo André,

vielen Dank für Deinen Lösungsvorschlag!
Leider ist das Ergebnis nicht wie erwartet.
Ich habe mal die Umbruchmarke in die Spalte 18 verlegt und mit Deinem Makro getestet.

Egal in welche Zeile ich die Marke handisch setze, der gewünschte Umbruch findet an einer anderen Stelle statt!

Hast Du vielleicht noch ne Idee warum das so ist?

Schön wäre natürlich, auch wenn die Umbruchmarken nicht händisch gesetzt werden müssten.

[schauan]

Hallöchen,

sorry, war in meinem Beitrag falsch beschrieben. mit "as" markiere ich einen Abschnittsbeginn.
Wenn man das nicht händisch setzen will könnte man z.B. nach der Farbe schauen. Allerdings muss man dann die Zellen einzeln durchgehen weil man die nicht mit "FIND" findet
Kennst Du Dich bisschen mit VBA aus ?
Im Prinzip entfällt das mit dem Find. Die Schleife könnte so etwas sein

Code:

Do While icnt <= ActiveSheet.UsedRange.Rows.Count
if cells(icnt,1).interior.color = ... Then Set c = cells(icnt,1)

'hier die Prüfung , Umbruch setzen usw

icnt=icnt+1
Loop

... wobei man die Verarbeitung auch etwas kürzer gestalten kann als im ursprünglichen code.

[sharky51]

Hallo André,

ja ein klein wenig kenne ich mich aus.

Habe es mal so versucht (abgewandeltes Beispiel aus dem Netz).
Aber auch hier muss ich die Marken für den Umbruch händisch setzen.

Code:

Sub SeitenumbruchXXX()
  Dim L As Long
 
  Application.ScreenUpdating = False
  ActiveSheet.PageSetup.PrintArea = ""
  ActiveSheet.ResetAllPageBreaks
  iRowL = Cells(Cells.Rows.Count, 1).End(xlUp).Row
  For L = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      If Cells(L, 18).Value = "AS" Then
        ActiveWindow.SelectedSheets.HPageBreaks.Add before:=Cells(L - 1, 18)
      End If
  Next
  Application.ScreenUpdating = True
  With ActiveSheet.PageSetup
      .PrintArea = "A1:O" & iRowL
  End With
  ActiveSheet.PrintPreview
End Sub

Um die blauen Zeilen zu ermitteln habe ich fogendes Makro:

Code:

Sub BlaueZeilen_zaehlen()
  Dim L As Long
  Dim zahl As Long
  Dim rowPos
 
  zahl = 0
  ActiveSheet.ResetAllPageBreaks
  iRowL = Cells(Cells.Rows.Count, 1).End(xlUp).Row
 
  For L = 6 To iRowL
      If Rows(L).Hidden = False Then
        If Cells(L, 15).Interior.ColorIndex = 23 Then
            zahl = zahl + 1        'Blaue Zeilen zählen
            rowPos = rowPos + 1    '
        End If
       
        If Cells(L, 15).Interior.ColorIndex = 23 Then
            rowPos = Cells(L, 17).Value
            '???????????
            '???????????
            'Cells(L, 18) = "PB"
        End If
      End If
  Next
  MsgBox zahl & " Zeilen im relevanten Bereich sind blaue Headder-Zeilen!"
 
  With ActiveSheet.PageSetup
      .PrintArea = Range(Cells(1, 1), Cells(iRowL, 17)).Address
  End With
  ActiveSheet.PrintPreview
End Sub

Ich ermittle hier die Anzahl der blauen Zeilen, die mir die Anzahl der unterschiedlichen Abschnitte liefert.
Wie ich aber jetzt per vba den automatischen Seitenumbruch generieren soll... da stehe ich gerade auf dem Schlauch.
Wie bereits gesagt sollen die Blöcke zwischen den blauen Zeilen nicht zerschnitten werden.

Vielleicht hast Du da noch eine Hilfestellung.

[schauan]

Hallo Erich,

das ist jetzt mal aufbauend auf dem ersten code, auch wenn der sicher noch etwas optimaler geht . Die Zählung ist übrigens für die Seitenumbrüche und nicht die Abschnittsmarker oder -farben. Hier kommt jetzt noch ein Zeilenzähler dazu.

Code:

Sub ZeilenUmbruchSetzen_Color()
'Variablendeklarationen
'Integer
Dim iCnt%, rCnt%, iFoundRow%, c As Range, firstAddress As String
'Mit dem Blatt 1
With Worksheets(2)
    'Seitenumbrueche zuruecksetzen
    .ResetAllPageBreaks
    'Zaehler fuer Seitenumbrueche setzen
    rCnt = 1: iCnt = 1
    'Erste Fundstelle ermitteln
    Do While Cells(rCnt, 1).Row < ActiveSheet.UsedRange.Rows.Count
    If Cells(rCnt, 1).Interior.Color = 15773696 Then
      Set c = Cells(rCnt, 1)
      Exit Do
    End If
    rCnt = rCnt + 1
    Loop
    'Wenn etwas gefunden wurde, dann
    If Not c Is Nothing Then
        'erste Fundstelle merken
        firstAddress = c.Address
        'Zeilennummer merken
        iFoundRow = c.Row
        'Schleife ueber alle Treffer
        Do
          'Wenn die Treffezeile unter der Umbruchzeile leigt, dann
          If c.Row > .HPageBreaks(iCnt).Location.Row Then
                'Seitenumbruch vor letztes WSC einfuegen
                .HPageBreaks.Add before:=Cells(iFoundRow, 1)
                'Zaehler hochsetzen
                iCnt = iCnt + 1
          'Ende Wenn die Treffezeile unter der Umbruchzeile leigt, dann
            End If
            'Trefferzeile merken
            iFoundRow = c.Row
            'naechsten Treffer suchen
            rCnt = rCnt + 1
            Do While Cells(rCnt, 1).Row < ActiveSheet.UsedRange.Rows.Count
            If Cells(rCnt, 1).Interior.Color = 15773696 Then
              Set c = Cells(rCnt, 1)
              Exit Do
            End If
            rCnt = rCnt + 1
            Loop
        'Ende Schleife ueber alle Treffer
        Loop While Not c Is Nothing And c.Address <> firstAddress And .HPageBreaks.Count >= iCnt
    'Ende Wenn etwas gefunden wurde, dann
    End If
'Mit dem Blatt 1
End With
End Sub

[sharky51]

Hallo André,

vielen Dank für Deine Mühe, passt schon fast.
Leider habe ich den Code noch nicht so ganz verstanden.

Der Seitenumbruch funktioniert .... aber leider noch nicht so ganz.
Datenblöcke werden an den Seitenenden des Ausdrucks immer noch zerstückelt.
Es sollte keine "blaue" Zwischen-Headder-Zeile am Seitenende des Druckblattes stehen und die dazugehörigen weiteren Datenzeilen auf dem nächsten Blatt weitergehen.
Heißt, wird bei "jeder" Druckseite die Anzahl der zu druckenden Zeilen pro Block überschritten, sollte der überlaufende Datenblock (auf der Seite) auf der nächsten Seite gedruckt werden.

Hast Du noch eine Idee wie sich das Zerstückeln vermeiden lässt?
Vielleich beschreibe ich das auch zu umständlich.

[schauan]

Hallo Erich,

dann müsste ich mal die Datei sehen, ...

[sharky51]

Hallo André,

hatte ich doch in meiner ersten Anfrage bereits angehängt...natürlich ohne Makros.

Reicht Dir Diese Datei?

[schauan]

... OK, schau ich mir morgen an