Seitenumbruch

Hallo,
Ich habe ein Arbeitsblatt, wo je nach Abfrage Werte in Tabellen eingefügt werden bzw. Tabellen gelöscht werden. Um keine "halben Tabellen" auf einer Seite zu haben, benötige ich einen Seitenumbruch. Meine Idee: Es soll sich immer der letzte Bereich auf einer Seite angeschaut werden. Wenn in dem Bereich etwas steht, dann soll das Makro so lange zurück laufen bis eine leere Zeile gefunden wird. Dort soll dann ein Seitenumbruch eingefügt werden.
Bereich = Range("A47:A50").Select
If Bereich "" Then
leerezeile: Cells(50, 1).End(xlUp).Offset(1, 0).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add before:=leerezeile
End If
Das klappt natürlich nicht :(
anbei sende ich euch eine Beispielmappe, die Original Datei darf ich leider nicht zu schicken. Ich hoffe ihr könnt mir helfen.
https://www.herber.de/bbs/user/124184.xlsm
lg Jasmin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Seitenumbruch

24.09.2018 13:47:25

Robert

AW: oder noch einfacher

24.09.2018 13:55:26

Robert

AW: oder noch einfacher

26.09.2018 09:02:03

Jasmin

AW: Seitenumbruch

24.09.2018 14:13:22

fcs

AW: Seitenumbruch

26.09.2018 09:00:24

Jasmin

AW: Seitenumbruch

26.09.2018 12:05:37

fcs

AW: Seitenumbruch

27.09.2018 11:35:43

Jasmin

Sub Umbruch() Dim lZ As Long, i As Long 'letzte befüllte Zeile in Spalte A lZ = Range("A" & Rows.Count).End(xlUp).Row 'leere Zelle in Spalte A suchen und Seitenumbruch einfügen For i = lZ To 2 Step -1 If Range("A" & i - 1) = "" Then ActiveSheet.HPageBreaks.Add before:=Range("A" & i) Exit For End If Next End Sub

Sub Seitenwechsel() ' Seitenwechsel einfügen, wenn Seitenumruch durch gefüllten Zellbereich geht. Dim Zeile_L As Long, Zeile_U As Long Dim iHPB As Integer, AnzHPagebreaks As Integer Dim wks As Worksheet Dim varView Set wks = ActiveSheet varView = ActiveWindow.View 'eingestellte Ansicht merken If varView xlPageBreakPreview Then ActiveWindow.View = xlPageBreakPreview With wks 'letzte Zeile mit Inhalt in Spalte A Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row 'Alle Seitenwechsel löschen .ResetAllPageBreaks AnzHPagebreaks = .HPageBreaks.Count If AnzHPagebreaks > 0 Then Do For iHPB = 1 To .HPageBreaks.Count Zeile_U = .HPageBreaks(iHPB).Location.Row 'Prüfen ob Zellen unter und oberhalb des Seitenwechsels Inhalt haben If .Cells(Zeile_U - 1, 1).Text "" And .Cells(Zeile_U, 1).Text "" Then 'nächste leere Zelle oberhalb suchen Do Zeile_U = Zeile_U - 1 If .Cells(Zeile_U - 1, 1).Text = "" Then .HPageBreaks.Add Before:=.Cells(Zeile_U, 1) Exit For End If Loop End If Next 'nächste leere Zelle unterhalb suchen Do Zeile_U = Zeile_U + 1 If .Cells(Zeile_U, 1).Text = "" Then Exit Do Loop If Zeile_U > Zeile_L Then GoTo Beenden Loop End If Beenden: End With 'vorherige Ansicht wieder herstellen If ActiveWindow.View varView Then ActiveWindow.View = varView End Sub

Hallo Jasmin,
das Problem scheint zu sein, dass das Makro in ein eine Endlosschleife gerät, wenn ein Zeilenblock über mehr als eine Seite geht.
Ich hab das Makro etwas angepasst - probiere es mal aus.
LG
Franz

Sub Seitenwechsel()
' Seitenwechsel einfügen, wenn Seitenumruch durch gefüllten Zellbereich geht.
Dim Zeile_L As Long, Zeile_U As Long
Dim iHPB As Integer, AnzHPagebreaks As Integer
Dim wks As Worksheet
Dim varView
Set wks = ActiveSheet
varView = ActiveWindow.View 'eingestellte Ansicht merken
If varView  xlPageBreakPreview Then ActiveWindow.View = xlPageBreakPreview
With wks
'letzte Zeile mit Inhalt in Spalte A
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
'Alle Seitenwechsel löschen
.ResetAllPageBreaks
AnzHPagebreaks = .HPageBreaks.Count
If AnzHPagebreaks > 0 Then
Do
For iHPB = 1 To .HPageBreaks.Count
If Zeile_U  "" And .Cells(Zeile_U, 1).Text  "" Then
'nächste leere Zelle oberhalb suchen
Do
Zeile_U = Zeile_U - 1
If .Cells(Zeile_U - 1, 1).Text = "" Then
.HPageBreaks.Add Before:=.Cells(Zeile_U, 1)
Exit For
End If
Loop
End If
End If
Next
'nächste leere Zelle unterhalb suchen
Do
Zeile_U = Zeile_U + 1
If .Cells(Zeile_U, 1).Text = "" Then Exit Do
Loop
If Zeile_U > Zeile_L Then GoTo Beenden
Loop
End If
Beenden:
End With
'vorherige Ansicht wieder herstellen
If ActiveWindow.View  varView Then ActiveWindow.View = varView
End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread