Bei obigem Code möchte ich zusätzlich gerne den Befehl einbetten, dass folgende Zeilen im Sheet "Besuch - Visite - Visita" zusammengehalten werden und bei einem Seitenumbruch nicht voneinander getrennt werden. Wurde der automatische Seitenumbruch somit z.B. ab Zeile A15 passieren, sollen die Zeilen A11:A18 automatisch auf die nächste Seite kommen.
Ich dachte, es könnte irgendwie mit dem Befehl "KeepTogether" möglich sein. Bin allerdings lediglich im Netz über den Begriff gestolpert ohne weitere Infos, so dass ich diesen leider nicht anwenden kann.
Vielleicht hat es ja aber jemanden hier im Forum, die/der dies kennt?!
wenn du in einem Makro entscheiden kannst, welche Zeilen zusammenbleiben sollen, kannst du ein Makro vor dem Drucken starten in dem
1. zuerst alle manuellen Seitenumbrüche gelöscht werden und dann
2. neue manuelle Seitenumbrüche gesetzt werden, wenn der automatische Umbruch innerhalb eines Blockes wäre.
Im Beispiel sollte der Seitenumbruch gleiche Sammel-Id nicht trennen.
helmut
Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität. Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
06.12.2022, 11:19 (Dieser Beitrag wurde zuletzt bearbeitet: 06.12.2022, 11:37 von snb.)
Je von Autofilter gehört ?
@ego
Mein Excel stürzt ab in 'Tuwat'.
Alternative:
Code:
Sub M_snb()
ResetAllPageBreaks
sn = UsedRange
y = 51
Do Until y > UBound(sn)
For j = y To 1 Step -1
If sn(j, 2) <> sn(j - 1, 2) Then Exit For
Next
HPageBreaks.Add Cells(j, 1)
y = j - 1 + 51
Loop
End Sub
06.12.2022, 11:20 (Dieser Beitrag wurde zuletzt bearbeitet: 06.12.2022, 11:23 von mauritius5.)
Herzlichen Dank für die Antwort.
Leider verstehe ich den Code nicht im Detail.
Könntest du die einzelnen Befehle kurz erläutern, so dass ich dies für mein Sheet anpassen kann?
Wie geschrieben, dürften diese Bereiche nicht getrennt werden:
- A11:A18
- A19:A28
- A29:A35
- ...
Herzlichen Dank!
Wozu?
Es arbeiten viele Personen an dem Sheet, wobei das Sheet immer ein bisschen anders ausschaut, da der Zellinhalt grösser oder kleiner sein wird. Wenn die entsprechende Person auf den Button "Drucken" klickt, soll beim Druck automatisch der Seitenumbruch angepasst werde. Es müsste also automatisiert ablaufen können.
Sub ZeilenZusammenhaltenBeiSeitenumbruch()
Dim lngV As Long
Dim oHP As HPageBreak
Dim rngA As Range, rngB As Range
Application.ScreenUpdating = False
With ActiveSheet
lngV = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview
Set rngB = Range("A11:A18,A19:A28,A29:A35,A36:A43,A44:A50,A51:A58,A59:A68,A69:A77,A78:A83,A84:A92")
For Each rngA In rngB.Areas
For Each oHP In .HPageBreaks
If Not Intersect(rngA.Offset(1).Resize(rngA.Rows.Count - 1), oHP.Location) Is Nothing Then
.HPageBreaks.Add rngA
End If
Next oHP
Next rngA
ActiveWindow.View = lngV
End With
Application.ScreenUpdating = True
End Sub
Vielen herzlichen Dank dafür. Der Code alleine funktioniert bereits einmal sehr gut.
Allerdings habe ich zwei weitere Punkte:
1. Den Code möchte ich gerne in diesen Code verpacken, wobei es leider schon wieder nicht mehr funktioniert. Ich schaffe es nicht, die beiden Codes zusammenzunehmen. Diesen Code habe ich einem Steuerelement zugewiesen. Er wird also ausgeführt, wenn das Kästchen angeklickt wird.
2. Bevor die Seitenumbrüche ausgeführt werden, müssten alle vorherigen Seitenumbrüche zurückgesetzt werden. Hierzu müsste ich irgendwie noch "ResetAllPageBreaks" einbetten können.
Kann mir jemand auch hierbei helfen? Mein Sheet nimmt langsam Form an, das ist echt perfekt.
Sub ZeilenZusammenhaltenBeiSeitenumbruch()
Dim lngV As Long
Dim oHP As HPageBreak
Dim rngA As Range, rngB As Range
Application.ScreenUpdating = False
With Worksheets("Besuch - Visite - Visita")
.Activate
Range("16:17").EntireRow.Hidden = WorksheetFunction.CountA(Rows(17)) = 0
Range("26:27").EntireRow.Hidden = WorksheetFunction.CountA(Rows(27)) = 0
Range("33:34").EntireRow.Hidden = WorksheetFunction.CountA(Rows(34)) = 0
Range("41:42").EntireRow.Hidden = WorksheetFunction.CountA(Rows(42)) = 0
Range("48:49").EntireRow.Hidden = WorksheetFunction.CountA(Rows(49)) = 0
Range("56:57").EntireRow.Hidden = WorksheetFunction.CountA(Rows(57)) = 0
Range("66:67").EntireRow.Hidden = WorksheetFunction.CountA(Rows(67)) = 0
Range("75:76").EntireRow.Hidden = WorksheetFunction.CountA(Rows(76)) = 0
Range("81:82").EntireRow.Hidden = WorksheetFunction.CountA(Rows(82)) = 0
Range("90:91").EntireRow.Hidden = WorksheetFunction.CountA(Rows(91)) = 0
lngV = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview
.ResetAllPageBreaks
Set rngB = Range("A11:A18,A19:A28,A29:A35,A36:A43,A44:A50,A51:A58,A59:A68,A69:A77,A78:A83,A84:A92")
For Each rngA In rngB.Areas
For Each oHP In .HPageBreaks
If Not Intersect(rngA.Offset(1).Resize(rngA.Rows.Count - 1), oHP.Location) Is Nothing Then
.HPageBreaks.Add rngA
End If
Next oHP
Next rngA
ActiveWindow.View = lngV
End With
Application.ScreenUpdating = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub
Zeilen zusammenhalten bei Seitenumbruch
