Blockweiser Seitenumbruch

Hallo,
ich suche eine Lösung für 2 Varianten von Seitenumbrüchen, wobei Daten-Blöcke nicht geteilt werden sollen.
Zur Erklärung:
Meine Tabelle ist in der Länge variabel, sie umfasst nur die Spalten A bis O. Die Überschriftenzeile ist Zeile 2, die Zeilen 1 und 2 sind in der Seitenansicht Wiederholungszeilen. Die Daten sind in Blöcken angeführt, das eindeutige Merkmal für den Beginn eines neuen Blockes ist, wenn in Spalte A Text oder Zahl steht und in der gleichen Zeile die Spalten B bis O leer sind und das 2 mal untereinander. In meinem Beispiel habe ich das farblich hervorgehoben. Im Beispiel umfasst der 1. Block die Zeilen 3 bis 19, der 2. Block die Zeilen 20 bis 44 usw.
Bei Variante 1 sollte der Seitenumbruch so festgelegt werden, dass soviel vollständige Blöcke wie möglich pro Seite untergebracht werden.
Bei Variante 2 sollte der Seitenumbruch so festgelegt werden, dass jeder Block auf einer eigenen Seite steht.
Besten Dank für die Hilfe und Servus, Walter
https://www.herber.de/bbs/user/85289.xls
Die Datei wurde mit Excel 2010 erstellt, habe ich aber in Excel 2003 abgespeichert.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Walter,
probier mal das hier (in ein allg. Modul, zu 3 Schaltflächen auf dem Tabellenblatt):


Option Explicit      ' Die Ansicht sollte vorher auf Normal stehen.
Sub SeitenumbrV()    ' Schaltfläche 1 - viele Blöcke/Seite
Seitenumbr 1
End Sub
Sub Seitenumbr1()    ' Schaltfläche 2 - ein Block/Seite
Seitenumbr 2
End Sub
Sub SeitenumbrWeg()  ' Schaltfläche 3
Dim varZ
With ActiveSheet
varZ = .PageSetup.Zoom                    ' Zoomfaktor merken
.ResetAllPageBreaks
.PageSetup.Zoom = varZ
End With
End Sub
Sub Seitenumbr(Variante As Integer)
Dim rngSel As Range, varZ, lngZ As Long, arZ() As Long, zz As Long
Dim ss As Long, lngRows As Long, nn As Long, aa As Long
Dim iView As XlWindowView
SeitenumbrWeg
With ActiveSheet
Set rngSel = Selection                    ' Markierung merken
varZ = .PageSetup.Zoom                    ' Zoomfaktor merken
iView = ActiveWindow.View                 ' Ansicht    merken
ActiveWindow.View = xlPageBreakPreview ' Ansicht Umbruchvorschau
If Variante = 2 Then
lngRows = 3                         ' max. Zeilen/Seite
Else
lngRows = .HPageBreaks(1).Location.Row - 1
End If
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim arZ(1 To lngZ)
Cells(lngZ, 1).Select
For zz = 3 To lngZ
If IsEmpty(.Cells(zz, 2)) * (Not IsEmpty(.Cells(zz, 1))) * _
IsEmpty(.Cells(zz + 1, 2)) * (Not IsEmpty(.Cells(zz + 1, 1))) * _
(.Cells(zz, .Columns.Count).End(xlToLeft).Column = 1) * _
(.Cells(zz + 1, .Columns.Count).End(xlToLeft).Column = 1) Then
ss = ss + 1
arZ(ss) = zz                        ' neuer Block ab Zeile
ElseIf lngRows > 3 And ss > 0 Then
If zz + 2 >= arZ(ss) + lngRows Then ' Block höher als 1 Seite
ss = ss + 1
arZ(ss) = zz                     ' 'künstl.' neuer Block
End If
End If
Next zz
ss = ss + 1
arZ(ss) = lngZ + 1
ReDim Preserve arZ(1 To ss)
.ResetAllPageBreaks                       ' alte Umbrüche löschen
.PageSetup.Zoom = varZ                    ' Zoomfaktor wiederherstellen
Cells(lngZ, 1).Select                    ' Ende markieren
aa = 1
For nn = 3 To ss                          ' Schleife über Blöcke
If arZ(nn) - arZ(aa) + 2 > lngRows Then
.HPageBreaks.Add Before:=.Cells(arZ(nn - 1), 1) ' neue Umbrüche
aa = nn - 1
End If
Next nn
End With
rngSel.Select                                ' Markierung wiederherstellen
ActiveWindow.View = iView                    ' Ansicht wiederherstellen
End Sub

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread