Drucken mit Übertrag

Manchmal möchte man eine Tabelle ausdrucken, die auf jeder Druckseite einen Übertrag enthält. Mit Bordmitteln ist das unter XL97 nicht zu machen. Mit etwas VBA und einer Excel4 Makrofunktion ist es aber möglich, vor dem Ausdrucken der einzelnen Seiten, die Summe der einzelnen Spalten bis zum gegenwärtigen Druckblatt zu berechnen. Diese Summe kann man dann in die zweite Zeile einfügen, wenn mal beim Einrichten der Seite die ersten zwei Zeilen als Wiederholungszeilen definiert hat. In der ersten Zeile stehen dann die Überschriften, in der zweiten die Überträge.

Beispieldatei Uebertrag.zip 17 kB

Sub Austesten()
Dim Spalten As Long, Blatt As Worksheet
Dim Druckblatt As Long
'Druckblatt festlegen
Set Blatt = Worksheets("Drucktest")
'Jedes Druckblatt einzeln durchlaufen
For Druckblatt = 1 To Druckseiten(Blatt)
    'Erste Spalte auslassen, da dort
    'andere Infos stehen, wie Buchungsdatum, etc.
    For Spalten = 2 To Blatt.UsedRange.Columns.Count
        'Die Summe jeder Spalte berechnen
        'und als Übertrag in die zweite Zeile
        Blatt.Cells(2, Spalten) = _
            SummeSpalteBisDruckblatt( _
            Druckblatt, Spalten, Blatt _
            )
        Blatt.Cells(2, 1) = "Summe bis Blatt " & Druckblatt - 1
    Next
    'Blatt drucken
    Blatt.PrintOut From:=Druckblatt, To:=Druckblatt
Next
End Sub

Public Function SummeSpalteBisDruckblatt(ByVal Blattnummer As Long, _
    ByVal Spalte As Long, Blatt As Worksheet) As Double
Dim LetzteZeile, ErsteZeile As Long
If Blattnummer = 1 Then Exit Function
'Summe bis zum letzten Eintrag des vorherigen Blatts,
'deshalb ...
Blattnummer = Blattnummer - 1
Blatt.Activate
'Erste Zeile nächstes Blatt ermitteln, deshalb weiter
'unten LetzteZeile - 1
LetzteZeile = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64)," _
    & Blattnummer & ")")
'Zeile 2 nimmt Übertrag auf, deshalb ist ...
ErsteZeile = 3
'Wenn LetzteZeile nicht Numerisch ist, ist letztes Blatt erreicht
If IsNumeric(LetzteZeile) Then
    'Die Summe der Spalte ermitteln
    SummeSpalteBisDruckblatt = _
        Application.WorksheetFunction.Sum( _
        Blatt.Range( _
        Blatt.Cells(ErsteZeile, Spalte), _
        Blatt.Cells(LetzteZeile - 1, Spalte)) _
        )
End If
End Function

Public Function Druckseiten(Blatt As Worksheet)
Dim dummy
Blatt.Activate
For Druckseiten = 1 To 10000
    dummy = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64)," _
        & Druckseiten & ")")
    'Wenn dummy nicht Numerisch ist, ist letztes Blatt erreicht
    If Not IsNumeric(dummy) Then Exit For
Next
End Function