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, 12:19 (Dieser Beitrag wurde zuletzt bearbeitet: 06.12.2022, 12: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, 12:20 (Dieser Beitrag wurde zuletzt bearbeitet: 06.12.2022, 12: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