This is a quick note to let you know the outcome.
After a day or so of being distracted elsewhere, I managed to get back to this and came up with the following:
The situation is:
A worksheet with a whole bunch of boxes connected by connectors.
The user selects one of more boxes and clicks "Alt+S".
The code then selects all of the connectors and boxes in the leg(s) below the user-selected items. So the user can now quickly rearrange the diagram one leg at a time - however far up- or down- the leg he chooses to grab.
My coding of it is almost certainly over-engineered yet somehow flawed, so feel free to suggest improvements if you like, but I've tested it and it does work.
The link to the "Alt+S" command is created using the line:
Code:
Application.OnKey "%s", "Select_Leg"
in the Workbook_Open event of the Thisworkbook module.
The code in the main module is:
Code:
Dim namecount As Long
Dim MyNames() As Variant
Dim shpconlist As ShapeConnections
Sub Select_Leg()
On Error Resume Next
CreateConnectorList
Dim shp As Shape
ReDim MyNames(1 To ActiveSheet.Shapes.Count) As Variant
For Each shp In Selection.ShapeRange
Get_Leg shp
If Err.Number <> 0 Then Err.Clear
Next shp
ReDim Preserve MyNames(1 To namecount) As Variant
ActiveSheet.Shapes.Range(MyNames()).Select
namecount = 0
End Sub
Public Sub CreateConnectorList()
On Error Resume Next
Dim wksht As Worksheet
Set wksht = Worksheets("Kids Cascade")
Dim shp As Shape
Set shpconlist = New ShapeConnections
For Each shp In wksht.Shapes
If shp.connector Then
If shp.ConnectorFormat.BeginConnected Then
shpconlist.Add shp.ConnectorFormat.BeginConnectedShape.Name, shp.Name, True
End If
If subshape.ConnectorFormat.EndConnected Then
shpconlist.Add shp.ConnectorFormat.EndConnectedShape.Name, shp.Name, False
End If
End If
Next shp
End Sub
Sub Get_Leg(thisshape As Shape)
Dim con As Variant
Dim i As Long
Dim dependentshape As Shape
namecount = namecount + 1
MyNames(namecount) = thisshape.Name
For i = 1 To shpconlist.Item(thisshape.Name).down.Count
con = shpconlist.Item(thisshape.Name).down(i)
namecount = namecount + 1
MyNames(namecount) = con
Set dependentshape = ActiveSheet.Shapes(con).ConnectorFormat.EndConnectedShape
Get_Leg dependentshape
Next i
End Sub
The class module code for the Shapeconnections collection class is:
Code:
Private mycol As Collection
Private Sub Class_Initialize()
Set mycol = New Collection
End Sub
Public Sub Add(shapename As String, connectorname As String, down As Boolean)
On Error Resume Next
'This process adds a new connector to the down collection or up collection for item mycol(shapename) (depending on the value of "down")
Dim thiscon As ShapeCon
Set thiscon = mycol(shapename)
If Err.Number <> 0 Then
Err.Clear
Set thiscon = New ShapeCon
mycol.Add Item:=thiscon, key:=shapename
End If
If down Then
thiscon.down.Add Item:=connectorname, key:=connectorname
Else
thiscon.up.Add Item:=connectorname, key:=connectorname
End If
Set mycol(shapename) = thiscon
End Sub
Public Property Get Item(shapename As String) As ShapeCon
Set Item = mycol(shapename)
End Property
and for the Shapecon class:
Code:
Public down As Collection
Public up As Collection
Private Sub Class_Initialize()
Set down = New Collection
Set up = New Collection
End Sub
In effect, what is happening is:
Select_Leg first creates a list of all the connections in a ShapeConnections object using the Createconnectors sub.
For each selected shap, it then recursively adds the name of each downwardly - dependent shape to a shared array called MyNames() using the sub Get_Leg.
It then creates a shaperange from the array of names in MyNames and selects the shaperange.
Messy huh? As I say, not the tidiest or most robust bit of code every produced, but it does what I need for now.
Thanks everyone for your help getting to this point.
Tony