Draw line and rename the added shape

[YasserKhalil]

Hello everyone
I am trying to draw a line between two cells and this is my try

Code: Select all

Sub Connect(r1 As Range, r2 As Range)
 With ActiveSheet.Shapes
    .AddLine r1.Left + r1.Width / 2, r1.top + r1.Height / 2, r2.Left + r2.Width / 2, r2.top + r2.Height / 2
    .Name = "MyLine"
 End With
End Sub

How can I rename the added line or shape using . Name method?

[YasserKhalil]

It seems I have to add a variable
This works fine for me

Code: Select all

Sub Connect(r1 As Range, r2 As Range, shName As String)
    Dim oShape As Shape
    Set oShape = ActiveSheet.Shapes.AddLine(r1.Left + r1.Width / 2, r1.top + r1.Height / 2, r2.Left + r2.Width / 2, r2.top + r2.Height / 2)
    oShape.Name = shName
End Sub

[YasserKhalil]

How can I add to this procedure if r1 is the same as r2 then to draw line within this cell from left to right across the cell?
Example if r1 is A3 and r2 is A3 then to draw horizontal line in A3 from left to right ..

[HansV]

An alternative of your first procedure:

Code: Select all

Sub Connect(r1 As Range, r2 As Range)
    ActiveSheet.Shapes.AddLine(r1.Left + r1.Width / 2, r1.Top + r1.Height / 2, _
        r2.Left + r2.Width / 2, r2.Top + r2.Height / 2).Name = "MyLine"
End Sub

[HansV]

And to accommodate r1 and r2 being the same:

Code: Select all

Sub Connect(r1 As Range, r2 As Range)
    If r1.Address = r2.Address Then
        ActiveSheet.Shapes.AddLine(r1.Left, r1.Top + r1.Height / 2, _
            r2.Left + r2.Width, r2.Top + r2.Height / 2).Name = "MyLine"
    Else
        ActiveSheet.Shapes.AddLine(r1.Left + r1.Width / 2, r1.Top + r1.Height / 2, _
            r2.Left + r2.Width / 2, r2.Top + r2.Height / 2).Name = "MyLine"
    End If
End Sub

[YasserKhalil]

That's great my tutor. Thanks a lot for helping all members.