Option Explicit
Option Base 0
Public Sub Test()
Dim obj As Object
Dim vnt As Variant
Dim i As Long
With Worksheets("Tabelle1")
'Anfang und Ende gleich = geschlossen
vnt = Array("G9", "I6", "H15", "G21", "F15", "E6", "G9")
For i = 0 To UBound(vnt)
With .Range(vnt(i))
vnt(i) = Array(.Left + .Width / 2, .Top + .Height / 2) 'x/y cell center
End With
If Not obj Is Nothing Then
obj.AddNodes msoSegmentLine, msoEditingAuto, vnt(i)(0), vnt(i)(1)
Else
Set obj = .Shapes.BuildFreeform(msoEditingCorner, vnt(i)(0), vnt(i)(1))
End If
Next
If Not obj Is Nothing Then
Set obj = obj.ConvertToShape
obj.Fill.Visible = msoFalse
obj.Line.Visible = msoTrue
obj.Line.ForeColor.RGB = rgbRed
End If
End With
End Sub
Grüße
|