Rahmen nur für gefüllte Zellen

[friedensbringer]

Hallo zusammen,

ich hoffe ihr könnt mir wieder einmal weiterhelfen.
Ich würde gerne in einer Tabelle einen Rahmen nur um gefüllte Zellen erstellen.

Ich habe dafür ein entsprechendes Makro gefunden das soweit auch gut funktioniert:

Code:

Sub Test()

Dim rBereich  As Range
Dim rZelle    As Range

    Set rBereich = Range("A3:I999")
    
    Application.ScreenUpdating = False
    
    For Each rZelle In rBereich
       If Trim$(rZelle) <> "" Then
          rZelle.BorderAround xlContinuous, xlThin
        Else
          rZelle.Borders.LineStyle = xlNone ' alle Linien löschen
       End If
    Next rZelle

End Sub

'#########################################################################################

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 5
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 5
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 5
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 5
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 5
        .TintAndShade = 0.399945066682943
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Ich möchte die Rahmenlinien allerdings nicht in schwarz sondern in einem bestimmten blau haben (so wie unterhalb der # ersichtlich).

Ich hoffe ihr könnt mir dabei helfen das entsprechend zu adaptieren.

Ich vermute das muss irgendwo hier hin?
rZelle.BorderAround xlContinuous, xlThin
Hab zwar schon versucht ThemeColor = 5 und TintAndShade = 0.399945066682943 zu ergänzen, aber irgendwie klappt das noch nicht wie gewünscht...

Vielen Dank und lg

Olli

[Steffl]

Hallo Olli,

vielleicht so?

Code:

Sub Test()

Dim rBereich  As Range
Dim rZelle    As Range

    Set rBereich = Range("A3:I999")
    
    Application.ScreenUpdating = False
    
    For Each rZelle In rBereich
       If Trim$(rZelle) <> "" Then
          rZelle.BorderAround xlContinuous, xlThin
          With rZelle.Borders
            .ThemeColor = 5
            .TintAndShade = 0.399945066682943
          End With
       Else
          rZelle.Borders.LineStyle = xlNone ' alle Linien löschen
       End If
    Next rZelle

End Sub

[friedensbringer]

Hallo Stefan,

vielen Dank - so einfach kanns gehen! :23:

Da macht man doch gleich noch lieber Feierabend!

lg

Olli

[RPP63]

Hi!
Mal ne blöde Frage:
Da Du ja nur eine dünne (blaue) Linie benötigst, warum nicht einfach per bedingter Formatierung?

Gruß Ralf