ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Selection order problem with code for shapes connection (https://www.excelbanter.com/excel-programming/337068-selection-order-problem-code-shapes-connection.html)

[email protected]

Selection order problem with code for shapes connection
 
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(msoConnectorStraig ht, 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

Selection order problem with code for shapes connection
 
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

--
HTH,

okaizawa

wrote:
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(msoConnectorStraig ht, 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


[email protected]

Selection order problem with code for shapes connection
 
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(msoConnectorStraig ht,
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



All times are GMT +1. The time now is 07:37 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com