Macro lijndikte bepalen

[rickvangurp]

Hallo,

Ik deze macro staan in mijn bestand. Nu wil ik de lijndikte bepalen de kleur lukte mij al. Maar waar kan ik de lijndikte veranderen/bepalen?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Selection.Count > 1 Or Intersect(Target, Range("B5:G215")) Is Nothing Then Exit Sub
Range("B" & Target.Row & ":G" & Target.Row).ClearContents
Target = "P": Cells(Target.Row, "O") = Target.Column - 1
End Sub
Sub Lijnen()
Dim lRij As Long
lRij = 5
Application.ScreenUpdating = False
RemoveLines
While Range("X" & lRij + 1) <> ""
Set ic = Range("A3:I4").Find(Range("X" & lRij).Value, , xlValues, xlWhole) ' .Column
Set iec = Range("A3:I4").Find(Range("X" & lRij + 1).Value, , xlValues, xlWhole) ' .Column

lb = Cells(1, ic.Column).Left + (Cells(1, ic.Column).Width / 2)
lt = Cells(lRij, ic.Column).Top + (Cells(lRij, ic.Column).Height / 2)
rb = Cells(lRij + 1, iec.Column).Left + (Cells(lRij + 1, iec.Column).Width / 2)
rt = Cells(lRij + 1, iec.Column).Top + (Cells(lRij, iec.Column).Height / 2)
ActiveSheet.Unprotect "test"
With ActiveSheet.Shapes.AddLine(lb, lt, rb, rt).Line
.ForeColor.RGB = RGB(255, 0, 0)
End With
lRij = lRij + 1
Wend
Application.ScreenUpdating = True
End Sub
Sub RemoveLines()
For Each wShape In ActiveSheet.DrawingObjects
wShape.Delete
Next

Graag jullie hulp!

 

[wampier]

With ActiveSheet.Shapes.AddLine(lb, lt, rb, rt).Line
.ForeColor.RGB = RGB(255, 0, 0)
.weight = 4
End With

 

[rickvangurp]

Dank je wel!

With ActiveSheet.Shapes.AddLine(lb, lt, rb, rt).Line
.ForeColor.RGB = RGB(255, 0, 0)
.weight = 4
End With