Zwischensummen vor Seitenumbruch
Klaus Baackmann
Ich habe das Problem, daß ich für ein Rechnungsformular vor Seitenumbrüchen
eine Zwischensumme der Beträge ausweisen muß, welche dann auf der Folgeseite
als erster Betrag wieder erscheinen soll. Dies soll natürlich wenn irgend
möglich automatisch passieren.
Über Lösungsvorschläge würde ich mich sehr freuen.
Klaus Baackmann
Jörg Nissen
glücklicher Zufall für Dich, daß ich gerade eine multiwährungs-
und -sprachfähige Sammelrechnung für unsere Firma fertiggestellt habe.
Nachfolgend ein VBA-Codefragment aus dem gesamten Projekt, daß sich genau
mit diesem Problem auseinandersetzt.
With ActiveSheet
With .Range(.PageSetup.PrintTitleRows)
iStartRow = .Row + .Rows.Count
End With
' Entfernen aller manuellen Seitenumbrüche
.ResetAllPageBreaks
iCnt = 1
' Bestimmen, wie groß der Druckbereich für die Positionszeilen ist
With .PageSetup
iDataArea = Application.CentimetersToPoints(29.7) - (.TopMargin +
.BottomMargin + ActiveSheet.Range(.PrintTitleRows).Height)
End With
' Alle Seitenumbrüche nachbearbeiten
Do While iCnt <= .HPageBreaks.Count
' Zelle hinter dem Seitenumbruch aktivieren und Zeilennummer merken
.HPageBreaks(iCnt).Location.Activate
iPBRow = ActiveCell.Row
' Ermitteln, wieviel vom Druckbereich noch frei ist
iRowFind = (iDataArea - .Range(.Cells(iStartRow, 1), .Cells(iPBRow -
1, 1)).Height)
' Solange nicht genug Platz für die Zwischensumme ist, eine Zelle nach
oben
Do While iRowFind \ iCellHeight < 2
ActiveCell.Offset(-1, 0).Activate
iRowFind = iRowFind + ActiveCell.Height
Loop
' Da maximal 2 Zeilen für ZS benötigt werden, hier die Beschränkung
iRowFind = Application.WorksheetFunction.Min(2, iPBRow -
ActiveCell.Row)
iPBRow = iPBRow - iRowFind + 1
' Die zwei Zeilen für ZS und Übertrag einfügen
With .Cells(iPBRow - 1, 1).EntireRow
.Insert shift:=xlShiftDown
.Insert shift:=xlShiftDown
End With
' Seitenumbruch einfügen
.HPageBreaks.Add before:=.Cells(iPBRow, 1)
' Text nach Sprachcode einfügen und Zellen formatieren
With .Cells(.HPageBreaks(iCnt).Location.Row - 1, 4)
.Formula = "=DGet(Übersetzung, 6, RGKunde!D1:D2)"
.Offset(1, 0).Formula = "=DGet(Übersetzung, 5, RGKunde!D1:D2)"
.HorizontalAlignment = xlHAlignRight
.EntireRow.RowHeight = iCellHeight * 2
.VerticalAlignment = xlVAlignBottom
.Offset(1, 0).HorizontalAlignment = xlHAlignRight
.Offset(1, 0).VerticalAlignment = xlVAlignTop
.Offset(1, 0).EntireRow.RowHeight = iCellHeight * 2
.Font.Bold = True
.Offset(1, 0).Font.Bold = True
End With
' Summenformel und Übertragsformel einfügen und formatieren
With .Cells(.HPageBreaks(iCnt).Location.Row - 1, 5)
.Formula = "=SUM(E" & Trim(Str(iStartRow)) & ":E" & Trim(Str(.Row -
1)) & ")"
.Offset(1, 0).Formula = "=E" & Trim(Str(.Row))
.Font.Bold = True
.Offset(1, 0).Font.Bold = True
.VerticalAlignment = xlVAlignBottom
.Offset(1, 0).VerticalAlignment = xlVAlignTop
.NumberFormatLocal =
Application.WorksheetFunction.DGet(ActiveWorkbook.Names("Devisen").RefersToR
ange, 4, ActiveWorkbook.Worksheets("RGKunde").Range("H1:H2"))
.Offset(1, 0).NumberFormatLocal = .NumberFormatLocal
End With
iStartRow = iPBRow
iCnt = iCnt + 1
Loop
End With
Dieses Codefragment ist zwar noch nicht universell für beliebige Ausdrucke
einsetzbar, zeigt aber den Weg auf, wie man es machen kann.
Jörg
"Klaus Baackmann" <Klaus.B...@t-online.de> schrieb im Newsbeitrag
news:8aotnr$lh0$1...@news07.btx.dtag.de...
: Hallo,
:
:
Klaus Baackmann
manchmal muß man einfach Glück haben, meinst Du nicht auch.
Es wird sicherlich noch ein bißchen dauern bis ich das Script auf
meine Bedürfnisse angepaßt habe. Aber es sieht recht vielversprechend
aus. Also besten Dank für Deine Bemühungen.
Klaus
Jörg Nissen <joerg....@t-online.de> schrieb in im Newsbeitrag:
u1DwkWyj$GA.251@cppssbbsa04...