Rahmen um den "beschriebenen" Bereich und Summen darunter

[Alooha]

Hallo,

ich bräuchte eine Makro, die das machen würde wie diejenigen, die ich in der angehängten Mappe aufgezeichnet habe.

Mit dem Unterschied, dass der Bereich sich nicht stur bis zur Zeile 23 für Blatt1 und Zeile 65 für Blatt2 erstreckt, sondern variabel ist.
D. h., in Blatt 1 soll der Rahmen den Bereich A3:E23 umfassen und die Zwischensummen sollen in Zeile 24 stehen, sowie die Gesamtsumme in Zeile 25.

Idem für das 2. Blatt; der Unterschied zu dem ersten besteht darin, dass das erste auf eine Seite passt, es für das 2. einen Seitenumbruch gibt, mit den Seitennummern.

Mit freundlichen Grüßen
Alooha

[Lutz Fricke]

Hallo Alooha,

probier mal diesen Code:

Code:

Sub Test()

Dim LetzteZeile

Cells.Borders.LineStyle = xlNone

LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Cells(LetzteZeile + 1, 4).FormulaR1C1 = "=SUM(R[-" & LetzteZeile - 2 & "]C:R[-1]C)"
Cells(LetzteZeile + 1, 5).FormulaR1C1 = "=SUM(R[-" & LetzteZeile - 2 & "]C:R[-1]C)"
Cells(LetzteZeile + 2, 3) = "Gesamt"
Cells(LetzteZeile + 2, 4).FormulaR1C1 = "=R[-1]C+R[-1]C[1]"

Range(Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 1), Cells(2, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Select
With Selection.Borders
   .LineStyle = xlContinuous
   .Weight = xlThin
End With

   With ActiveSheet.PageSetup
       .FitToPagesWide = 1
       .FitToPagesTall = 1
       .CenterFooter = "Seite &P von &N"
       .LeftMargin = Application.InchesToPoints(0.708661417322835)
       .RightMargin = Application.InchesToPoints(0.708661417322835)
       .TopMargin = Application.InchesToPoints(0.393700787401575)
       .BottomMargin = Application.InchesToPoints(0.47244094488189)
       .HeaderMargin = Application.InchesToPoints(0.31496062992126)
       .FooterMargin = Application.InchesToPoints(0.118110236220472)
       .Orientation = xlPortrait
       .PaperSize = xlPaperA4
       .FirstPageNumber = xlAutomatic
       .Order = xlDownThenOver
       .BlackAndWhite = False
       .Zoom = 100
       .PrintErrors = xlPrintErrorsDisplayed
       .ScaleWithDocHeaderFooter = True
       .AlignMarginsHeaderFooter = True
   End With
   Application.PrintCommunication = True
   'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
       IgnorePrintAreas:=False
   ActiveWindow.SelectedSheets.PrintPreview

End Sub

Diese Makro setzt die Summen unter die letzte in Spalte A benutzte Zeile und macht einen Rahmen um den gesamten benutzten Bereich außer Zeile 1.

Beim Aufzeichnen eines Makros solltest Du vorher genau wissen, was du tust und nur genau das machen. Jeder Schritt wird aufgezeichnet, wenn Du also 3 Mal an den Rahmen bastelst, schreibt dir Excel 3 Mal die Änderung ins Makro. Das wird unübersichtlich...

Gruß,
Lutz