Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1604to1608
1604to1608
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

dynamischer seitenumbruch mit vba

Forumthread: dynamischer seitenumbruch mit vba

dynamischer seitenumbruch mit vba
01.02.2018 12:46:00
michael
hallo miteinander
wie erstelle ich für meine gefilterte Liste angepasste automatische Seitenumbrüche. je nach aktiver Häkchen der Steuerelemente werden unterschiedliche große Blöcke generiert die dann über Das Formularsteuerelement drucken ausgedruckt werden können. bei diesem vorgang hätte ich gerne das die block überschriften auch immer dabei stehen...ähnlich wie die wiederholzeile oben. ggf. für jeden Block eigene makros mit erkennung ob filter true bzw false.
mfg meikel
datei: https://www.herber.de/bbs/user/119463.xlsm
Anzeige

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: (mühsames) Auszählen
01.02.2018 12:58:20
Fennek
Hallo Michael,
um flexibel zu bleiben, wird es keine andere Wahl geben, als vor dem Drucken die sichtbaren Zeilen zu zählen und an einer Kapitelüberschrift einen Seitenwechsel einzufügen.
Soll jeweils die Titelzeilen wiedeholt werden? Sollen die ersten 10 Zeilen (grau markeiert) gedruckt werden?
mfg
Anzeige
AW: (mühsames) Auszählen
01.02.2018 14:04:17
michael
der eingestellte Druckbereich bezieht sich nur auf die liste, nicht auf die ersten 10 zeilen.
a11:p243 ist dieser.
AW: ein Anfang
01.02.2018 14:42:22
Fennek
Hallo,
um die Zeilen zu finden, an den ein Seitenumbruch eingefügt werden sollte, hilft dieser Code:

Sub Titel_suchen()
If Range("C16").MergeArea.Count > 1 Then Debug.Print
For i = 16 To Cells(Rows.Count, 3).End(xlUp).Row
If Cells(i, 3).MergeArea.Count > 2 Then
Debug.Print Cells(i, 3).MergeArea.Address
i = i + 2
End If
Next i
End Sub
Jetzt müssen die tatsächlichen Umbrüche damit verglichen werden und dann ein pagebreak auf der vorherigen Soll-Stelle eingefügt werden.
Dieser Schritt war mir zu mühsam.
mfg
Anzeige
AW: 2. Schritt
01.02.2018 15:35:12
Fennek
Hallo,
so ähnlich wie der folgende Code könnte es gehen. Es gibt aber Problem, wenn ein Kapitel größer als eine Seite ist. Zum weiteren debuggen habe ich keine Lust.

Dim Tx As String
Sub Titel_suchen()
For i = 16 To Cells(Rows.Count, 3).End(xlUp).Row
If Cells(i, 3).MergeArea.Count > 2 Then
'Debug.Print Val(Split(Cells(i, 3).MergeArea.Address, "$")(2))
Tx = Tx & Val(Split(Cells(i, 3).MergeArea.Address, "$")(2)) & "#"
i = i + 2
End If
Next i
Debug.Print Tx
End Sub
Sub Drucken()
Dim WS As Worksheet: Set WS = ActiveSheet
RR = Split(Tx, "#")
Debug.Print WS.HPageBreaks.Count
With WS.PageSetup
.PrintTitleRows = "$11:$15"
End With
'alte PageBreak löschen
For i = WS.HPageBreaks.Count To 1 Step -1
WS.HPageBreaks.Item(i).Delete
Next i
'neue break einfügen
For i = 1 To WS.HPageBreaks.Count
R = CInt(Split(WS.HPageBreaks.Item(i).Location.Address, "$")(2))
For k = 0 To UBound(RR)
If CInt(RR(k)) > R Then
N = CInt(RR(k - 1))
Exit For
End If
Next k
WS.HPageBreaks.Add Cells(N, 3)
Next i
End Sub
Mal sehen, ob du es findest.
mdf
Anzeige
AW: zum Üben
02.02.2018 09:34:48
Fennek
Hallo,
vielleicht findet sich jemand, der auch an diesem Thema üben möchte.
Der Code sollte recht "nahe dran sein", aber ein paar Macken gibt es noch:

Sub T1()
Dim WS As Worksheet: Set WS = ActiveSheet
Dim HPb As HPageBreak
WS.ResetAllPageBreaks
With WS.PageSetup
hp = 1
r = Range(.PrintArea).Row
For i = Range(.PrintArea).Row + 3 To Range(.PrintArea).Row + Range(.PrintArea).Rows.Count -  _
1
If Cells(i, 3).MergeArea.Count > 2 Then
If WS.HPageBreaks(hp).Location.Row
mfg
Anzeige
AW: zum Üben
02.02.2018 09:38:12
michael
vielen dank :)
ich werde es mal versuchen zu integrieren, muss ich dazu alle versionen zusammenfügen oder ist nur deine letzte version zu beachten?
AW: nur die letzte (owT)
02.02.2018 12:20:42
Fennek
AW: Final Version
02.02.2018 16:23:54
Fennek
Hallo,
dieser Code sollte auch für die letzte Seite funktionieren:

Sub T1()
Dim WS As Worksheet: Set WS = ActiveSheet
Dim HPb As HPageBreak
WS.ResetAllPageBreaks
With WS.PageSetup
hp = 1
r = Range(.PrintArea).Row
lr = Range(.PrintArea).Row + Range(.PrintArea).Rows.Count
For i = Range(.PrintArea).Row + 3 To lr
If Cells(i, 3).MergeArea.Count > 2 Or i = lr Then
If WS.HPageBreaks(hp).Location.Row
mfg
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige