VBA 2013 - oberste Zeile im markierten Bereich ansprechen

Question

Hallo Excel-Fangemeinde,

leider habe ich es nicht hinbekommen, dass die oberste Zeile aus einem markierten Bereich angesprochen werden kann.

Der markierte Bereich ist variable und wird mittels STRG+A oder zu Fuß- je nach Größenverhältnis ausgewählt.

Danach lasse ich ein Makro laufen, dass mir die Zellen mit einem Gitterraster markiert, was auch soweit funktioniert.

Da ich aber die oberste mitmarkierte Zeile noch in Fett und mit einem dickeren Rahmen (unten) versehen möchte, habe ich nun das Problem - wie spreche ich diese erste Zeile an.

Aktuell sieht mein Makro so aus und mein Versuch die oberste Zeile anzusprechen ist misslungen, da in dem nachstehenden Makro die unterste Zeile dick unterstrichen wird.

Ich bedanke mich schon mal bei allen Interessierten für das reinschauen und wünsche allen noch einen weiterhin hoffentlich stressfreien und schönen Frühlingstag.

In diesem Sinne... have a nice Day... Gruß Helmut

Sub Rahmensetzen()
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
'****************************************************** nur oberste Zeile ************************
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Answer 1

Hallo Helmut,

das sollte reichen

Option Explicit

Sub test()
With Selection
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).TintAndShade = 0
.Borders(xlEdgeBottom).TintAndShade = 0
.Borders(xlEdgeRight).TintAndShade = 0
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
With Range(Cells(Selection.Row, Selection.Column), _
Cells(Selection.Row, Cells(Selection.Row, _
Columns.Count).End(xlToLeft).Column))
.Font.Bold = True
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
Range("A1").Select
End Sub

Gruß
Rainer

Answer 2

Hallo Rainer,

vielen Dank mal wieder für Deine tolle Unterstütung.

Es funktioniert soweit wie es sein sollte - bis auf das ich noch die einen Rahmenlinien anpassen werde... aber das sollte jetzt auch nicht mehr das Problem sein, da die Vorgaben dafür in meinem Makro stehen.

Dir und allen anderen nochmals danke für das Interesse und noch einen schönen Abend.... Gruß Helmut

Answer 3

Hallo Helmut,

sorry, das war der falsche Code.
Hier der Richtige.

Option Explicit

Sub test()
With Selection
.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeTop).Weight = xlHairline
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeRight).Weight = xlThick
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
With Range(Cells(Selection.Row, Selection.Column), _
Cells(Selection.Row, Cells(Selection.Row, _
Columns.Count).End(xlToLeft).Column))
.Font.Bold = True
.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeRight).Weight = xlThick
End With
Range("A1").Select
End Sub

Gruß
Rainer

Answer 4

Hallo Rainer,

na dann - nochmals vielen vielen Dank fürs "nacharbeiten".

Ich bin bis jetzt noch nicht dazu gekommen, da mich die aktuellen Tagesgeschäfte auf Trapp halten.

In diesem Sinne... have a nice Day... Gruß Helmut