Excel 2007 - VBA Rahmen erstellen

Question

Hallo,

ich möchte gern Rahmenlinien setzen.

Ich hab mit dem Makrorekorder aufgezeichnet und etwas angepasst, aber geht das nicht irgendwie einfacher bzw. Übersichtlicher / kürzer?

1. Vorgang - Zeige im Autofilter alle an.
2. Vorgang - Setze Rahmen ab Zeile 6 bis zur letzten beschriebenen Zeile (in M steht in allen Zeilen etwas)
3. 2 Zeilen nach der letzten beschriebenen Zeile eine Teilsumme (in grauem Kasten)

Danke schonmal im voraus...


hier-meine-Makroaufzeichnung.docx

Answer 1

Link: Mein augezeichnetes Makro

Jetzt geht`s

Gruß
Florian

Answer 2

hallo,

da es sich um die Wordwiedergabe eines Teil des Makros handelt, wird das Nachvollziehen schwierig. Wir kennen den übrigen Zusammenhang und den Aufbau deiner Tabelle nicht und können / wollen diese auch nicht nachbauen.

Nur mit dem Text ist es bei dem Umfang kaum zu machen

Gruß

Helmut

Answer 3

Hallo Florian,

ich habe dir das Makro mit dem Rahmen mal etwas gekürzt und so angepasst, dass der Rahmen nur bis zur letzten Zeile gesetzt wird:

Sub Rahmen()

Dim lzeile As Long

lzeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

'Alle Daten des Blattes anzeigen
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

'Rahmen ziehen
With Range("A6:M" & lzeile).Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With

With Range("G6:G" & lzeile).Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

End Sub

Um in einem zusammenhängenden Zellbereich den Hintergrund einzufärben verwende den folgenden Code:

With Range(Cells(Loletzte, 3), Cells(Loletzte, 5)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With

Gruß

M.O.

Answer 4

Hallo M.O.,

vielen Dank. Hab es noch ein wenig an meine "Bedürfnisse" angepasst.

Sub Rahmen()

Dim lzeile As Long

lzeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

'Alle Daten des Blattes anzeigen
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

'Rahmen ziehen
With Range("A6:M" & lzeile).Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With

With Range("G6:G" & lzeile).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Range("A6:M" & Cells(Rows.Count, 13).End(xlUp).Row).BorderAround(xlContinuous)
End With

End Sub

Sieht gleich viel übersichtlicher aus.

Gruß Florian