Zeilen zusammenhalten bei Seitenumbruch
#1
Liebe Leute

Code:
Sub Makro7()
    Sheets(Array("Besuch - Visite - Visita")).Select
    Sheets("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
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

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.

A11:A18
A19:A28
A29:A35
A36:A43
A44:A50
A51:A58
A59:A68
A69:A77
A78:A83
A84:A92

Habt ihr eine Idee, wie ich diese anstellen könnte?

Herzlichen Dank und herzliche Grüsse
mauritius5
Antworten Top
#2
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?!
Antworten Top
#3
Hallo m...,

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.


Angehängte Dateien
.xlsm   Seitenumbruch.xlsm (Größe: 42,1 KB / Downloads: 5)
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.





Antworten Top
#4
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
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#5
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.
Antworten Top
#6
Hallo,

teste mal diesen Code:

Code:
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

Gruß Uwe
Antworten Top
#7
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.
Code:
Sub Makro7()
    Sheets(Array("Besuch - Visite - Visita")).Select
    Sheets("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
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

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.
Antworten Top
#8
Hallo,

vielleicht so:

Code:
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

Gruß Uwe
Antworten Top
#9
Boah, es passt. Vielen, vielen Dank!!!
Antworten Top
#10
Und was hast du nun gelernt ?
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste