Einen dicken Rahmen setzen per VBA

Einen dicken Rahmen um eine Zelle zu setzen, kann mehrere Ausgangssituationen haben. Du willst zum Beispiel einen Marktführer in einer Tabelle entsprechend markieren, oder willst den Standort mit dem größten Umsatz ermitteln. Das sind alles Beispiele, die man über die Sortierfunktionen manuell bearbeiten könnte oder mit der Skriptsprache VBA automatisch. Unser Ziel ist es für eine Umsatztabelle den Standort mit dem größten Umsatz zu markieren. Dazu nutzen wir die Möglichkeit über VBA den Rahmen zu setzen und wie das Layout des Rahmens aussehen soll.

Bestimmung der Zelle

Als erstes musst Du die Zelle bestimmen in welcher der erste Platz vergeben ist. Dazu schreibe als erstes die folgende Funktion :

Private Sub SetFirstPlace()
    Dim i As Long
    Dim max, maxi As Double
    
    ' Das Tabellenblatt mit der Rangliste auswählen
    Worksheets("Rangliste").Select
    
    ' Den maximal Wert aus der Spalte D im Bereich D6 bis D12 ermitteln
    maxi = WorksheetFunction.max(Range("D6:D12"))
    max = WorksheetFunction.Match(maxi, Range("D:D"), 0)    
End Sub

Als erstes wird in der Funktion das Tabellenblatt Rangliste ausgewählt. Dann wird über die Funktion WorksheetFunction.Max und einem bestimmten Bereich der Maximalwert ermittelt und in der Variable maxi gespeichert. Danach wird über die Funktion WorksheetFunction.Match in der Spalte D nach dem gespeicherten Wert in maxi gesucht und die Zeilennummer in der Variable max gespeichert.

Löschen der alten Markierung

Um jetzt nicht zwei Markierungen in der Liste zu haben, muss erst die alte Markierung gelöscht werden. Dazu schreibst Du eine weitere Funktion, die alle Zellen im Bereich B6 – B12 durchgeht und den Standardrahmen der Tabelle für alle Zellen setzt. Die Funktion sieht folgendermaßen aus :

Private Sub DeleteFirstPlaceBorder()
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = black
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = black
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = black
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = black
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Mit der Funktion ist es aber alleine noch nicht getan. Die folgenden Zeilen müssen am Ende der Funktion SetFirstPlace angehängt (vor dem End Sub) werden:

    Range("B6:B12").Select
    Call DeleteFirstPlaceBorder

Damit wird der Bereich B6 bis B12 markiert und der entsprechende Rahmen aus der Funktion DeleteFirstPlaceBorder um die Markierung gesetzt.

Setzen der Markierung für den ersten Platz

Nachdem jetzt die alte Markierung gelöscht wurde, kannst Du nun die neue Markierung für den ersten Platz setzen. Dazu schreibe die folgende Funktion in Dein Modul :

Private Sub SetFirstPlaceBorder()
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = RGB(255,0,0)
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = RGB(255,0,0)
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = RGB(255,0,0)
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = RGB(255,0,0)
        .TintAndShade = 0
        .Weight = xlThick
    End With
End Sub

Diese Funktion setzt einen roten dicken Rahmen um die Zelle, die über die erste Funktion SetFirstPlace mit den Befehlen WorksheetFunction.Max und WorksheetFunction.Match ermittelt wurde. Wenn Du eine andere Farbe haben möchtest, ändere dazu einfach den Wert Color. Für die Strichstärke den Wert Weight und für die Linienart den Wert LineStyle. Genaue Werte für die genannten Eigenschaften findest Du am Ende der Anleitung. Nun noch die folgenden Zeilen in die Funktion SetFirstPlace am Ende hinzufügen : (vor dem End Sub)

    Range("B" & max).Select
    Call SetFirstPlaceBorder

Mit der ersten Zeile wird der Cursor auf die ermittelte Zelle gesetzt. Dann wird die Funktion SetFirstPlaceBorder aufgerufen und der rote dicke Rahmen wird gesetzt. Damit hast Du eine variable Markierung, die immer den ersten Platz anhand den Werten in der Spalte D entsprechend in der Spalte B markiert.

Zum Schluß kannst Du hier noch eine Beispiel Excel-Datei herunterladen, die den kompletten Quelltext inkl. Beispieltabelle enthält.

Wertetabelle für die Linien :

Eigenschaften	Werte
LineStyle	xlContinuous ; xlDash ; xlDashDot ; xlDashDotDot ; xlDot ; xlDouble ; xlLineStyleNone ; xlSlantDashDot
Color	z.B. RGB(255,0,0) für Rot oder durch die Angabe der Grundfarbe in Englisch (z.B. black, yellow)
Weight	xlHairline ; xlMedium ; xlThick ; xlThin