Selection order problem with code for shapes connection

[brotherescott]

I am trying to write a little macro that will connect the 2 selected
autoshapes flow chart boxes. My problem is if I put 5 boxes on the
worksheet and have them ordered 5-4-3-2-1. If I select #5 and them #4
it wants to connect #4 to #5. My code can not get the name of the first
selected box(#5) as item(1).name. You can see all the ways I tried to
get A & B to give me A=5 and B=4 in the scenario I described. If anyone
can help me on my selection order problem I would appreciate it.
Thanks
Scott


Sub shapeconnect()
A = Selection.Item(1).Name
B = Selection.Item(2).Name

A = Selection.ShapeRange.Item(1).Name
B = Selection.ShapeRange.Item(2).Name

A = Selection.ShapeRange(1).Name
B = Selection.ShapeRange(2).Name

A = Selection(1).ShapeRange.Item(1).Name
B = Selection(2).ShapeRange.Item(1).Name

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 129.75,
130.5, 1.5, 16.5).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.Flip msoFlipHorizontal
Selection.ShapeRange.Flip msoFlipVertical
Selection.ShapeRange.ConnectorFormat.BeginConnect
ActiveSheet.Shapes(A), 3
Selection.ShapeRange.ConnectorFormat.EndConnect
ActiveSheet.Shapes(B), 1
End Sub

 

[okaizawa]

Hi,

the following code works in excel 2000.

'accessing object(e.g. "selobj(i).Name") seems to reset selection order.

Function SelectedObjects() As Variant
Dim a() As Object, obj As Object
Dim i As Long
If TypeName(Selection) = "DrawingObjects" Then
ReDim a(1 To Selection.Count)
For Each obj In Selection
i = i + 1
Set a(i) = obj
Next
SelectedObjects = a
End If
End Function

Sub Test()
Dim selobj As Variant
Dim i As Long
selobj = SelectedObjects()
If IsArray(selobj) Then
For i = 1 To UBound(selobj)
Debug.Print selobj(i).Name
Next
End If
End Sub

 

[brotherescott]

Thanks for the sanity check. I could not figure out what was happening.
It is kind of odd that .name changes the selection order.
I tweaked the code you sent me and it works perfectly for my
application. I can select 10 autoshapes and it puts arrows between each
of them in the order that I selected them.
Thanks a ton!!!
Scott

Here is the code I ended up with for those who are interested:

Function SelectedObjects() As Variant
Dim a() As Object, obj As Object
Dim i As Long
If TypeName(Selection) = "DrawingObjects" Then
ReDim a(1 To Selection.Count)
For Each obj In Selection
i = i + 1
Set a(i) = obj
Next
SelectedObjects = a
End If
End Function


Sub Test()
Dim selobj As Variant
Dim i As Long
'accessing object(e.g. "selobj(i).Name") seems to reset selection
order.
selobj = SelectedObjects()
If IsArray(selobj) Then
For i = 1 To UBound(selobj) - 1
Debug.Print selobj(i).Name
ActiveSheet.Shapes.AddConnector(msoConnectorStraight,
129.75, 130.5, 1.5, 16.5).Select
Selection.ShapeRange.Line.EndArrowheadStyle =
msoArrowheadTriangle
Selection.ShapeRange.Flip msoFlipHorizontal
Selection.ShapeRange.Flip msoFlipVertical
Selection.ShapeRange.ConnectorFormat.BeginConnect
ActiveSheet.Shapes(selobj(i).Name), 3
i = i + 1
Selection.ShapeRange.ConnectorFormat.EndConnect
ActiveSheet.Shapes(selobj(i).Name), 1
i = i - 1
Next
End If
End Sub