Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Dynamischer Seitenumbruch

Betrifft: Dynamischer Seitenumbruch von: Niko
Geschrieben am: 25.08.2014 14:47:06

Hallo Zusammen,

ich habe eine ziemlich lange Pivottabelle für die Reports in unserem Unternehmen. Ich habe ein Makro erstellt, mit dem der Druckbereich dynamisch erstellt wird und anschließend das Sheet als PDF gespeichert sowie gedruckt wird. Nun habe ich allerdings das Problem, dass die Seitenumbrüche willkürlich gesetzt werden. Gibt es eine Möglichkeit eines dynamischen Seitenumbruchs?

Als Beispiel: Wenn die Seite voll ist, soll das Makro schauen, ob in Spalte B in der jeweiligen Zelle, wo es sonst den Seitenumbruch hinzufügt, etwas steht. Wenn ja, soll darüber der Seitenumbruch erfolgen. Wenn nein, soll der Seitenumbruch soweit noch oben verschoben werden, bis in der Zelle etwas steht.

Ich hoffe, ich konnte mein Problem halbwegs schildern. Hab dazu auch mal eine Beispieldatei erstellt: https://www.herber.de/bbs/user/92281.xlsx

Und hier mein Makro fürs Speichern, welches ich zurzeit verwende:

Sub DruckenFBS()

'Zellenberechnungen aktualisieren
ActiveSheet.Calculate

'Druckbereich definieren
Dim AnzahlEinträgeZeilen As Integer
Dim AnzahlEinträgeSpalten As Integer

    'Spalten-/Zeileneinträge werden gezählt
    Zeilen = WorksheetFunction.CountA(Sheets("Report FBS").Range("I1:I20000"))
    Spalten = WorksheetFunction.CountA(Sheets("Report FBS").Range("A4:L4"))

        With ActiveSheet.PageSetup

            'Festlegung auf Hochformat
            .Orientation = xlLandscape
            'Druckbereich definieren
            .PrintArea = Range(Cells(1, 1), Cells(Zeilen + 12, Spalten)).Address
            'Seitenbreite definieren
            .FitToPagesWide = 1
            'Seitenhöhe definieren
            .FitToPagesTall = False
            'Seitenzahl bestimmen
            .CenterFooter = "&8Seite &P von &N"
    
        End With

'Als PDF an Wunschort speichern
UserForm2.Show
UserForm2.Hide

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Sheets("GrundlageReportFBS").Cells( _
19, 3) & "\" & Sheets("Report FBS").Cells(1, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties _
            :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      
'Druckmöglichkeit
Dim x As Byte

x = Application.InputBox("Wie oft soll gedruckt werden ?", "Drucken", 0, Type:=1)

If x <> False Then
        
        Sheets("Report FBS").PrintOut Copies:=x
    
End If

'Druckbereich wieder aufheben
Dim Tabelle As Worksheet
    
    For Each Tabelle In ActiveWorkbook.Worksheets
        Tabelle.PageSetup.PrintArea = ""
    Next Tabelle
    
'Kommentare löschen
Sheets("Report FBS").Range("N5:N11").ClearContents
Sheets("Report FBS").Range("N21:N10000").ClearContents
    
'Meldung über das Ende
MsgBox ("Erfolgreich ausgeführt!")
    
End Sub

  

Betrifft: AW: Dynamischer Seitenumbruch von: Daniel
Geschrieben am: 25.08.2014 15:02:55

Hi

zum Verschieben der Zeilenumbrüche nach oben kannst du folgenden Code verwenden:

Sub test()
Dim i As Long
i = 1
With ActiveSheet
    .ResetAllPageBreaks
    Do While i <= .HPageBreaks.Count
        If .Cells(.HPageBreaks(i).Location.Row, 2).Value = "" Then
            .HPageBreaks.Add Before:=.Cells(.HPageBreaks(i).Location.Row, 2).End(xlUp)
        End If
        i = i + 1
    Loop
End With
End Sub

Gruß Daniel


  

Betrifft: AW: Dynamischer Seitenumbruch von: Niko
Geschrieben am: 25.08.2014 15:10:59

Hi Daniel,

bei deinem Code bekomme ich den Laufzeitfehler (9): Index außerhalb des gültigen Bereichs.

Vielleicht noch als Information wegen dem Befehl .ResetAllPageBreaks: in meiner richtigen Datei habe ich in Zeile 18 einen manuellen Seitenumbruch hinzugefügt, welches auch weiterhin bestehen soll.

Vielen Dank im Voraus und viele Grüße
Niko


  

Betrifft: AW: Dynamischer Seitenumbruch von: Daniel
Geschrieben am: 25.08.2014 15:16:45

Hi
kann ich jetzt nicht nachvollziehen.
In welcher Programmzeile tritt der Fehler denn auf?
in deiner Beispieldatei war kein Manueller Wechsel drin, warum sollte ich das berücksichtigen?
die Programmzeile mit dem ResetAllPagebreaks kannst du ja rausnehmen, wenn sie stört.
Dann bleiben halt die alten Zeilenumbrüche drin, wenn der Code ein zweites mal laufen muss.

Gruß Daniel


  

Betrifft: AW: Dynamischer Seitenumbruch von: Rudi Maintaire
Geschrieben am: 25.08.2014 15:13:27

Hallo,

Sub aaa()
  Dim i As Integer, rng As Range
  ActiveWindow.View = xlPageBreakPreview
  With ActiveSheet
    .ResetAllPageBreaks
    For i = 1 To .HPageBreaks.Count
      Set rng = .HPageBreaks(i).Location
      Do While rng.Offset(, 1) = ""
        Set rng = rng.Offset(-1)
      Loop
      Set .HPageBreaks(i).Location = rng
    Next
  End With
  ActiveWindow.View = xlNormalView
End Sub

Gruß
Rudi


 

Beiträge aus den Excel-Beispielen zum Thema "Dynamischer Seitenumbruch"