Selecting dynamic sets of shapes.

[N1GHTEYES]

This seems simple but I'm struggling to get anything useful out of the help and it's driving me nuts.

All I need to do is select, in code, a user-specified subset of shapes on a sheet.

Specifically he selects an area of the sheet, then the code notes all the shapes which lie in that area and selects them.

I can create a list of the shapes which meet the criteria. I can even select each one of them in turn, but how do I select ALL of them? If I knew beforehand what they were I could use the:

Shapes.Range(Array(name1, name2, name3, name4)).Select
method.

But I've tried that - I created an array of shape names called selectedshapes() and used:
ActiveSheet.Shapes.Range(selectedshapes()).Select

This did not work.

Then I tried creating a shaperange object and using the .add method to add each shape in turn before finally selecting the shaperange. But that did not work either.

I'm sure this must be simple, but I guess I'm just being dumb today.

As usual, any help would be much appreciated.

Tony

 

[SkipVought]

hi,

WHY do you want to SELECT them?

What's the thing that you want to do with the selection?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[N1GHTEYES]

I know how you feel about selecting Skip, but in this case I think it is necessary. I want the user to be able to easily select and manually move subsets of the shapes. The first step is selecting them.

To give you a bit more background: I have a moderately complex model (about 150 variables) of a system (a sensor as it happens). I've built this up in Excel to examine various trade-offs in the design (gimbal max acceleration, optics field of view, detector sensitivity etc...) to determine how these affect performance figures (e.g. ground resolution, minimum scene contrast sensitivity, maximum coverage per second etc...). Very few of the dependencies are simple (some items have layers of dependencies which are 17 levels deep).

Additionally, some of the relationships between some of the input parameters are not currently known with certainty. Consequently, in some instances, I want the user (me in this case) to be able to have optional inputs which can override values partway through some of the dependency chains. Given the meshed nature of many of the dependencies, and the depth of the layers, it can be a bit fraught to determine exactly where these override values should go and what criteria govern whether it is valid to use them.

So I've coded a means to take the variables and lay out a representation of them as a dependency diagram. On a separate sheet, I've created a set of objects. Each object represents one variable and contains a group of boxes. Each group holds: Variable name, description, units and value (actually a link to the cell - so it is "live" in the diagram). Then, in code, I've drawn connectors between all of the groups and each of their precedents. I have iteratively searched through the dependency chains to determine how many dependency layers each group has, and I have laid them out in the diagram in this order, from left to right. That initially makes the diagram more or less sensible, but it is still a bit of a complex mess initially. Therefore some manual intervention is required at that stage to help make the whole thing easier to understand. Because they are actual connectors, rather than just lines, if I move the groups around, the connectors come with them. That means that I can change the appearance of the layout to make it more comprehensible.

But doing so one group at a time is a nuisance. I want to be able to select sections of the diagram and move them en masse. So I want the user to be able to select a portion of the spreadsheet and, in doing so, also select the groups which lie in that area. Hence my original question.

So any help in being able to select a user-specified group of objects would be really appreciated.

If it helps, here is the code I have so far:

Sub mnuShapes_SelectHighlighted()
'This menu item (in the user-defined Shapes menu) finds all the objects whose top-left corner lies inside the current spreadsheet selection area.
'It then counts and lists the number of object types in that area.
'The user is then offered the option to select any / all of those types.
'The sub then selects each of that / those type(s) of objects in the area.  This is done
'with the intention of allowing the user to move or modify those objects en masse.

    Dim seltop As Single, selleft As Single, selright As Single, selbot As Single
    Dim numshapes As Long, selcount As Long, totshapes As Long, i As Long
    Dim reply As String, shapetypes As String
    Dim typelist As Variant, varray As Variant
    Dim dummyarray(1 To 1) As String
    Dim coltypes As New Collection
    Dim shp As Shape
    Dim shprng As ShapeRange
    On Error Resume Next

    'start by finding the size of the selected area
    With Selection
        seltop = .Top
        selleft = .Left
        selright = .Left + .Width
        selbot = .Top + .Height
    End With
    
    'now find and list the types of objects which lie in the selection area
    For Each shp In ActiveSheet.Shapes
        If shp.Top >= seltop And shp.Left >= selleft Then
            'Add each type to a collection using the type number (as a string) as the key.
            'If the type is already in the collection, this will not be added, but throw an error instead -
            'so clear the error and continue.
            coltypes.Add item:=shp.Type, key:=Trim(Str(shp.Type))
            Err.Clear
            totshapes = totshapes + 1
        End If
    Next shp
    
    'if there is more than one type, get the user to specify which type(s) he wants to select
    'put these into an array contained in a variant (even if there is only one type)
    If coltypes.Count = 0 Then
        Exit Sub
    Else
        If coltypes.Count > 1 Then
            For i = 1 To coltypes.Count
                If Len(shapetypes) > 0 Then
                    shapetypes = shapetypes & ", "
                End If
                shapetypes = shapetypes & Str(coltypes(i))
            Next i
            reply = InputBox("There are " & Str(coltypes.Count) _
                             & "shape types in the selection.  These are " _
                             & shapetypes & _
                             ".  Please specify the types you want to select.", _
                             "Select shape type", Str(coltypes(1)))
            If InStr(1, reply, ",") Then
                typelist = Split(reply, ",")
            Else
                dummyarray(1) = reply
                typelist = dummyarray()
            End If
        Else
            dummyarray(1) = coltypes(1)
            typelist = dummyarray()
        End If
    End If
    
    'go through the shapes again, this time selecting them
    'if they are in the selection area and of the right type.
    
    '(THIS IS THE BIT WHICH DOES NOT WORK)
    numshapes = UBound(typelist)
    ReDim selectedshapes(1 To totshapes) As String
    For Each shp In ActiveSheet.Shapes
        If shp.Top >= seltop And shp.Left >= selleft _
                      And shp.Top <= selbot And shp.Left <= selright Then
            For i = 1 To numshapes
                If shp.Type = typelist(i) Then
                    selcount = selcount + 1
                    selectedshapes(selcount) = shp.name
                    'shprng.Add shp 'alternative method - also does not work
                    Exit For
                End If
            Next i
        End If
    Next shp
    ReDim Preserve selectedshapes(1 To selcount) As String
    varray = selectedshapes()
    ActiveSheet.Shapes.Range(varray).Select
    'shprng.Select 'alternative method - also does not work
End Sub

The bit which is not working is the actual selecting bit - below the line "'(THIS IS THE BIT WHICH DOES NOT WORK)". Specifically, what actually does not work is the line

ActiveSheet.Shapes.Range(varray).Select

It gives error 1004 "The specified parameter has an invalid value".

But if I use the watch on the variable varray it shows it holds a single dimensioned array, each element of which holds a string. That should be functionally identical to:

ActiveSheet.Shapes.Range(Array("name1", "name2", "name3")).Select

So why is it giving an error? I don't know.

I have also tried putting the array Selectedshapes() directly into the selecting line (not via a variant), i.e.

ActiveSheet.Shapes.Range(Selectedshapes()).Select

This also does not work.

I have scoured the help on shapes and shaperanges, but it seems mostly to concentrate on retriving shapes rather than adding them. In the cases where it does add them, it is where ALL the shapes are added, or a specific, predetermined subset is added via the Array() method. I cannot find any Help instance where
it does what I need to do - i.e. add an actual array of items, or add them one item at a time.

Tony

 

[N1GHTEYES]

More info:

I have also tried the following methods:

using the Union method to join one shape at a time to a specified shaperange object:

    numshapes = UBound(typelist)
    For Each shp In ActiveSheet.Shapes
        If shp.Top >= seltop And shp.Left >= selleft _
                      And shp.Top <= selbot And shp.Left <= selright Then
            For i = 1 To numshapes
                If shp.Type = typelist(i) Then
                    If selcount = 0 Then
                        Set shprng = ActiveSheet.Shapes.Range(shp.name)
                    Else
                        Set shprng = Union(shprng, ActiveSheet.Shapes.Range(shp.name))
                    End If
                    selcount = selcount + 1
                    Exit For
                End If
            Next i
        End If
    Next shp
    shprng.select

Using a second shaperange object and Union:

    numshapes = UBound(typelist)
    Dim shprng2 As ShapeRange
    For Each shp In ActiveSheet.Shapes
        If shp.Top >= seltop And shp.Left >= selleft _
                      And shp.Top <= selbot And shp.Left <= selright Then
            For i = 1 To numshapes
                If shp.Type = typelist(i) Then
                    If selcount = 0 Then
                        Set shprng = ActiveSheet.Shapes.Range(shp.name)
                    Else
                        Set shprng2 = ActiveSheet.Shapes.Range(shp.name)
                        Set shprng = Union(shprng, shprng2)
                    End If
                    selcount = selcount + 1
                    Exit For
                End If
            Next i
        End If
    Next shp
    shprng.select

Neither of the above works.

In both cases the only object to be selected is the first to be added. The rest fail to add to the shprng shaperange.

Tony

 

[SkipVought]

Well that's a legitimate use of select.

I want the user to be able to easily select and manually move subsets of the shapes. The first step is selecting them.

Well the Windows method of multiple selection is ctr + select.

The other option might be to turn on a selection option (toggle button) and have the user just point an click until the selections are complete. Then the second toggle might be to click to move the group, could be mulitple times to get the right position.

This simple test worked for me, moving shapes 1 & 3 GROUP to another position, with the same relative 'group' positioning. The process for calculating the move parameters (relative x,y) could be done using a throw-away line shape, for instance.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

my test

    Dim sr As Object
    
    Set sr = Sheet2.Shapes.Range(Array(1, 3)).Group
    
    sr.Top = 0
    sr.Left = 0
    
    sr.Ungroup
    
    Set sr = Nothing

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[N1GHTEYES]

Thanks Skip.

The problem with using array()directly to select is that you have to know which shapes are going to be selected when you write the code.

The user (me) could certainly select the group of shapes manually using ctr, but I'd rather select an area then grab all the shapes in that area.

However, after much faffing about, I've finally figured out exactly what combination of syntax excel finds acceptable. Here it is:

    numshapes = UBound(typelist)
    ReDim selectedshapes(0 To totshapes - 1) As Variant
    For Each shp In ActiveSheet.Shapes
        If shp.Top >= seltop And shp.Left >= selleft _
                      And shp.Top <= selbot And shp.Left <= selright Then
            For i = 1 To numshapes
                If shp.Type = typelist(i) Then
                    selectedshapes(selcount) = shp.name
                    selcount = selcount + 1
                    Exit For
                End If
            Next i
        End If
    Next shp
    ReDim Preserve selectedshapes(0 To selcount - 1) As Variant
    ActiveSheet.Shapes.Range(selectedshapes).Select

The above selects all the objects included in selectedshapes.

It does NOT work if you write it as:
ActiveSheet.Shapes.Range(selectedshapes()).Select

or if you put:
dim varray as variant
varray=selectedshapes()
ActiveSheet.Shapes.Range(varray).Select

or if you dim selectedshapes as string.

It seems to me that all of the above should be synonymous with
ActiveSheet.Shapes.Range(selectedshapes).Select
... but apparently they are not.

Still, problem solved.

Tony

 

[SkipVought]

Duh, there are no events for seleting shapes.

How about this.

First the user SELECTS a group of objects. Then run this which moves them to a predetermined position, with the GetEmAnMoveEm button...

Dim sa()

Sub btnGetEmAnMoveEm()
    GetGroup
    MoveGroup
End Sub

Sub GetGroup()
    Dim i As Integer, iCnt As Integer, sp As Object
    
    iCnt = Selection.ShapeRange.Count
    
    ReDim sa(iCnt - 1)
    
    For Each sp In Selection.ShapeRange
        sa(i) = sp.Name
        i = i + 1
    Next
End Sub

Sub MoveGroup()
    Dim sr As Object

    Set sr = Activesheet.Shapes.Range(sa).Group
    
    sr.Top = 0
    sr.Left = 0
    
    sr.Ungroup
    
    Set sr = Nothing
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[N1GHTEYES]

Skip, thanks. Having figured out the code to dynamically create the shaperange I'm after (see my previous post) I think your sa method would work.

But the point is I don't want the user to have to manually select the group of objects. It would be quicker to select an area of cells, then use a menu item to select the objects which lie on that area. That is what my previously posted code now does (after I figured out the syntax Excel would accept).

Having got a whole bunch of objects selected, I can then manually select just one of them and move the lot as a bunch.

So, thanks as always for the suggestion, but, in this case, I think I've got it sorted. (famous last words...)

Tony

 

[SkipVought]

Just modified GetGroup to work from a RANGE SELECTION...

Sub GetGroup()
    Dim r As Range, sp As Shape, i As Integer
    
    For Each r In Selection
        For Each sp In ActiveSheet.Shapes
            With sp.TopLeftCell
                If r.Row = .Row And r.Column = .Column Then
                    ReDim Preserve sa(i)
                    sa(i) = sp.Name
                    i = i + 1
                End If
            End With
        Next
    Next
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[N1GHTEYES]

Skip, that is more or less what I ended up with, except I don't think you need the nested loop, and I modded it a bit to give the user the choice of which type of object to select.

Rather than using the topleftcell, I used the actual position. Since you're interested, here is the code I actually used.

Sub mnuShapes_SelectHighlighted()
'This menu item (in the user-defined Shapes menu) finds all the objects
'whose top-left corner lies inside the current spreadsheet selection area.
'It then counts and lists the number of object types in that area.
'The user is then offered the option to select any / all of those types.
'The sub then selects each of that / those type(s) of objects in the area.  This is done
'with the intention of allowing the user to move or modify those objects en masse.

    Dim seltop As Single, selleft As Single, selright As Single, selbot As Single
    Dim numshapes As Long, selcount As Long, totshapes As Long, i As Long
    Dim reply As String, shapetypes As String
    Dim typelist As Variant
    Dim dummyarray(1 To 1) As String
    Dim coltypes As New Collection
    Dim shp As Shape
    Dim shprng As ShapeRange
    On Error Resume Next

    'start by finding the size of the selected area
    With Selection
        seltop = .Top
        selleft = .Left
        selright = .Left + .Width
        selbot = .Top + .Height
    End With
    
    'now find and list the types of objects which lie in the selection area
    For Each shp In ActiveSheet.Shapes
        If shp.Top >= seltop And shp.Left >= selleft Then
            'Add each type to a collection using the type number (as a string) as the key.
            'If the type is already in the collection, this will not be added, but throw an error instead -
            'so clear the error and continue.
            coltypes.Add item:=shp.Type, key:=Trim(Str(shp.Type))
            Err.Clear
            totshapes = totshapes + 1
        End If
    Next shp
    
    'if there is more than one type, get the user to specify which type(s) he wants to select
    'put these into an array contained in a variant (even if there is only one type)
    If coltypes.Count = 0 Then
        Exit Sub
    Else
        If coltypes.Count > 1 Then
            For i = 1 To coltypes.Count
                If Len(shapetypes) > 0 Then
                    shapetypes = shapetypes & ", "
                End If
                shapetypes = shapetypes & Str(coltypes(i))
            Next i
            reply = InputBox("There are " & Str(coltypes.Count) _
                             & "shape types in the selection.  These are " _
                             & shapetypes & _
                             ".  Please specify the types you want to select.", _
                             "Select shape type", Str(coltypes(1)))
            If InStr(1, reply, ",") Then
                typelist = Split(reply, ",")
            Else
                dummyarray(1) = reply
                typelist = dummyarray()
            End If
        Else
            dummyarray(1) = coltypes(1)
            typelist = dummyarray()
        End If
    End If
    
    'go through the shapes again, this time selecting them
    'if they are in the selection area and of the right type.
    numshapes = UBound(typelist)
    ReDim selectedshapes(0 To totshapes - 1) As Variant
    For Each shp In ActiveSheet.Shapes
        If shp.Top >= seltop And shp.Left >= selleft _
                      And shp.Top <= selbot And shp.Left <= selright Then
            For i = 1 To numshapes
                If shp.Type = typelist(i) Then
                    selectedshapes(selcount) = shp.name
                    selcount = selcount + 1
                    Exit For
                End If
            Next i
        End If
    Next shp
    ReDim Preserve selectedshapes(0 To selcount - 1) As Variant
    
    'this is the bit where the selection actually happens
    ActiveSheet.Shapes.Range(selectedshapes).Select
End Sub

The last 20 or so lines are equivalent to the last code you posted. The rest is doing the other stuff of finding which types are there and getting the user to pick an appropriate subset of types.

It would be neater if I presented the user with a list of the actual types of object in the selected area, rather than the type-numbers, but it will do for now.

Tony