Microsoft Excel

Herbers Excel/VBA-Archiv

Seitenumbruch, Zwischensumme und Übertrag


Betrifft: Seitenumbruch, Zwischensumme und Übertrag
von: Max Maurer
Geschrieben am: 17.04.2019 14:02:30

Hallo,
ich habe ein Problem mit VBA, dass mich jetzt schon ewig beschäftigt.
Es geht darum, dass ich eine Warenrechnung von Excel in Word umwandeln will. Die für die Rechnung relevanten Daten fangen in Zeile 20 an und es gibt 8 Reihen (bis H).

Mein Ziel ist, dass bei jedem Seitenumbruch eine Zwischensumme eingefügt wird und ein Übertrag der Zwischensumme auf der nächsten Seite eingefügt wird.

In einem Wordblatt werden mir 22 Zeilen ausgegeben (falls es irgendwie weiterhilft).
Würde es mit einem Einfügen von einer Zwischensummenrechnung nach 21 Zeilen klappen ?

Ich komme seit Tagen leider nicht weiter und hoffe Ihr könnt mir da weiterhelfen.

  

Betrifft: AW: Seitenumbruch, Zwischensumme und Übertrag
von: fcs
Geschrieben am: 20.04.2019 11:48:17

Hallo Max,

hier eine Beispieldatei mit dem nachfolgenden Makro.
http://www.herber.de/bbs/user/129284.xlsm

LG
Franz

Sub RechnungZwischenSummen()
    Dim wks As Worksheet
    Dim AnzZeilenproSeite As Long
    Dim Zeile_T As Long, Zeile As Long, Zaehler As Long
    Dim bolSeite1 As Boolean
    
    Set wks = ActiveSheet
    
    With wks
        Zeile_T = 19 'Überschriften-Zeile
        AnzZeilenproSeite = 22
        
        Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        'Text + Formeln für Summenzeile
        .Cells(Zeile + 2, 1) = "Summe"
        .Cells(Zeile + 2, 8).FormulaR1C1 = "=Subtotal(9,R" & (Zeile_T + 1) & "C:R[-1]C)"
        
        Zaehler = 0
        Zeile = Zeile_T + 1
        Do
            Zeile = Zeile + 1
            If .Cells(Zeile, 1) = "" Then Exit Do
            If Zaehler = AnzZeilenproSeite - 2 Then
                '2 Leerzeilen einfügen
                .Range(.Rows(Zeile), .Rows(Zeile + 1)).Insert
                'Zeile für Zwischensumme ausfüllen
                .Cells(Zeile, 1).Value = "Zwischensumme"
                .Cells(Zeile, 8).FormulaR1C1 = "=Subtotal(9,R" & (Zeile_T + 1) & "C:R[-1]C)"
                'Zeile für Übertrag ausfüllen
                .Cells(Zeile + 1, 1).Value = "Übertrag"
                .Cells(Zeile + 1, 8).FormulaR1C1 = "=Subtotal(9,R" & (Zeile_T + 1) & "C:R[-1]C)" _

                
                Zaehler = 0
                Zeile = Zeile + 1
            Else
                Zaehler = Zaehler + 1
            End If
        Loop
    End With
End Sub