Excel vba Variable Druckbereiche

[sharky51]

Ok, super!
Wünsche noch einen schönen Abend!

[sharky51]

... OK, schau ich mir morgen an

Hallo André,

darf ich nochmals nachfragen ob Du nochmals Zeit und Muße hattest Dich mit dem Thema zu beschäftigen?

[schauan]

Hallöchen,

nicht dass ich meine Antwort anderswo angehängt habe. Hatte es probiert und bei mir funktioniert es. Hatte das auch noch als pdf angehängt
Du must die Farbnummer an zwei Stellen ändern, hast Du das?
Ich such mal noch, hatte aber am Montag Abend meine Downloads usw. aufgeräumt

---

... die pdf hab ich gerade gefunden

[sharky51]

Hallo André,

sorry wenn ich mich nochmals zu dem Thema melde und Dich dadurch nerve.

Ich glaube ich habe jetzt herausgefunden, warum bei mir die gewünschte Seitenumbrüche nicht so funktioniert wie ich mir das vorstelle.
Dein Makro, vielen Dank nochmals dafür, funktioniert auch bestens!

Wenn aber einige Zeilen nicht dieselbe Zeilenhöhe haben, d.h. sich ein Textumbruch in einer oder mehreren Zeilen in Spalte "E" stattfindet, dann funktioniert der Umbruch nicht an der gewünschten Zeile. Wie beschrieben sollte trotzdem immer die Seite nach dem Seiten-Headder mit einer "blauen" Abschnittszeile beginnen.

Ich habe Dir mal zwei Beispiele beigefügt. Vielleicht fällt Dir dazu noch eine Möglichkeit ein, unabhängig von Zeilenhöhen den Seitenumbruch, wenn nötig, an den richtigen Stellen zu setzen.

[schauan]

Hallo Erich,

das Problem liegt an Deinen Farben. Es ist nicht überall das gleiche Dunkelblau

[sharky51]

Hallo André,

das wundert mich aber sehr.

Wenn ich etwas gleich haben möchte formatiere ich immer mit dem Format-Pinsel. Es müsste also an diesen Stellen gleich sein.
Habe das gerade nochmals für jede "blaue" Headderzeile durchgeführt .... leider mit dem gleichen fehlerhaften Ergebnis.

Weiter habe ich mal meine Zellfarbe so ausgelesen:
Debug.Print Selection.Interior.Color = 12611584
Debug.Print Selection.Interior.ColorIndex = 23

Das ist ein anderer Wert den Du in Deinem Makro definiert hattest.
Setze ich meinen ermittelten Wert in Dein Makro ein bekomme ich auch nicht das Ergebnis das ich erwarte.
Im Gegenteil das Makro bricht mit dem Fehler"Überlauf" ab.

Scheint irgendwie der Wurm drin zu sein, bzw. Dein blau ist nicht mein blau. 

[schauan]

Hallöchen,

also, ich hab zum Test vorhin die Farbe mit dem Pinsel übertragen, anschließend die pdf gedruckt und das Ergebnis war ok. Ich habe auch im Debug-Fenster mal die Treffer-Zeilen ausgegeben. Vorher habe ich nur einen Seitenumbruch gesetzt, danach 2

Hier mal der Auszug aus dem Debug-Fenster mit den Treffer-Zeilen und den Umruch-Zeilen

$A$24
$A$30
$A$40
1 $A$30 $A$40
$A$46
$A$52
$A$56
$A$61
$A$71
2 $A$61 $A$71
$A$76

und hier der angepasste code. Ich hab neben den Debug-Anweisungen noch eine Ende-Bedingung beim äußeren Loop hinzugefügt, damit sich das Ding nicht todläuft - falls es mal nach dem UsedRange weiter macht

Code:

Sub ZeilenUmbruchSetzen_Color()
'Variablendeklarationen
'Integer
Dim iCnt%, rCnt%, iFoundRow%, c As Range, firstAddress As String
'Mit dem Blatt 1
With Worksheets(1)
    '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 = 12611584 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)
                Debug.Print iCnt & vbTab & Cells(iFoundRow, 1).Address & vbTab & c.Address
                '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 = 12611584 Then
              Set c = Cells(rCnt, 1)
              Debug.Print c.Address
              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 And rCnt <= ActiveSheet.UsedRange.Rows.Count
    'Ende Wenn etwas gefunden wurde, dann
    End If
'Mit dem Blatt 1
End With
End Sub

.

[sharky51]

Hallo André,

ich werde heute Abend mal testen und melde mich dann wieder.

Erst mal, nein zum wiederholten Male, vielen Dank für Deine Bemühungen..... toll Deine Hilfe!!!!!

Habe gerade mal einen Test versucht....das Makro läuft leider nicht durch und bleibt hier hängen mit:
Laufzeitfehler 9: Index außerhalb des gültigen Bereichs

'Wenn die Treffezeile unter der Umbruchzeile leigt, dann
If c.Row > .HPageBreaks(iCnt).Location.Row Then

Zuvor habe ich den kompletten Bereich den ich ausdrucken möchte markiert, also Druckbereich markieren. Sonst habe ich nicht weiter eingestellt.

Du schreibst: "Vorher habe ich nur einen Seitenumbruch gesetzt, danach 2".
Ich gehe davon aus das soll das Makro erledigen oder?

[schauan]

Hi Erich,

ja, das hat das Makro erledigt Könnte sein, dass der Fehler kommt, wenn noch nicht gedruckt bzw. keine Seitenvorschau aufgerufen wurde und deswegen noch keine Seitenumbrüche im Blatt sind. Muss ich mir mal noch anschauen.

[sharky51]

Hi André,

ok, ich freue mich wenn Du Dir das nochmals ansehen möchtest.

Btw. In der Durckvorschau sehe ich ja bereits, dass das Endergebnis noch nicht passt.