Selecting shapes based on its name and then arranging them in a circle

[Submeg]

Hello all,

I am currently facing two problems:

1. How to select a subset of items on the worksheet based on their name
2. How to arrange these in a circle

Background:​

I also code in AutoHotkey, and I have been using the Radial Menu for many years. There is a support tool that allows you to easily load in functions on a GUI, rather than working in text files.

Unfortunately, for me and a few others, this tool has not been working correctly for some time. I have been manually updating files in the background, but for others, this is less than ideal.

To get around this, I created a tool with Excel VBA that creates the text file directly, to make the process less "fiddly".

One of the aspects I'd like to add is to replicate the visual component of the native designer. This requires circles to be laid out in a circle, and the "tightness" of this circle is dependent on a) how many items are in each ring and b) which ring it is. See below for an example:

The Problem - #1:​

I have created six items to create the inner ring to start with; each item is named - Item1, Item2, Item3 and so on.

I used the VBA recorder to see that the items are selected like so:

ActiveSheet.Shapes.Range(Array("Item1", "Item2", "Item3", "Item4", "Item5", "Item6")).Select

I then tried to replicate this based on how many items are in a ring, as defined by the user; I was able to get the "selection string" to match that of the recorded version like so:

'Ring1 - select

Do While SelectionCounter < Ring1
    
    'Start
    If SelectionString = "" Then
    
        'SelectionString = Chr(34) & "Item" & (SelectionStart + SelectionCounter) & Chr(34)
        SelectionString = "Item" & (SelectionStart + SelectionCounter) & Chr(34)
    
    'End
    ElseIf (Ring1 - 1) = SelectionCounter Then
    
        'SelectionString = SelectionString & ", " & Chr(34) & "Item" & (SelectionStart + SelectionCounter) & Chr(34)
        'SelectionString = SelectionString & ", " & "Item" & (SelectionStart + SelectionCounter)
        
        SelectionString = SelectionString & ", " & Chr(34) & "Item" & (SelectionStart + SelectionCounter) '& Chr(34)
        
    
    Else
    
        'SelectionString = SelectionString & ", " & "Item" & (SelectionStart + SelectionCounter)
    
        SelectionString = SelectionString & ", " & Chr(34) & "Item" & (SelectionStart + SelectionCounter) & Chr(34)
        
    
    End If
    
    SelectionCounter = SelectionCounter + 1
    
Loop

This results in the string begin created like so:



But when I try to run this, it returns:

Run-time error '1004': The item with the specified name wasn't found
I did find this code, which selects all items that fall within a selected area, and was trying to see if I could replicate based on the name instead. I would have hoped my version worked, but alas...

The Problem - #2:​

Once I am able to select the items, I would like to arrange them as per how they appear in the image above. I was able to find this code which does indeed align them around a circle, however, "item 1" is placed at "3 o'clock" as opposed to 12, and so the alignment is different to the designer I am trying to replicate (see the image above). When I manually select the items and run the alignment code, it turns out like this (I have selected the "first" circle that is placed):



My code for the alignment is so far:

Call AlignShapesInCircle(625, 700, 47, ActiveWindow.Selection.ShapeRange)


'https://answers.microsoft.com/en-us/msoffice/forum/all/aligning-shapes-in-a-circle-using-vba/170632a9-427b-46c1-90ea-c0f7f8235863

Function AlignShapesInCircle(x As Single, y As Single, r As Single, shprng As ShapeRange)
'x,y    = center point of the circle
'r      = radius of the circle
'shprng = the shape selection that needs to be arranged

Dim angle As Single
Dim currentangle As Single
Dim x1 As Single
Dim y1 As Single
Dim i As Integer

Dim itemCount As Long

currentangle = 0
angle = 360 / shprng.Count

itemCount = 0

For currentangle = 0 To 359 Step angle
    i = i + 1
    x1 = r * Cos(D2R(currentangle))
    y1 = r * Sin(D2R(currentangle))
    
    If itemCount = 0 Then
    
        shprng(i).Left = x + x1
        shprng(i).Top = y + y1
        
    Else
    
        shprng(i).Left = x + x1
        shprng(i).Top = y + y1
    
    End If
    
    
    itemCount = itemCount + 1
    
Next

End Function

Function D2R(Degrees) As Double
    D2R = Degrees / 57.2957795130823
End Function
 
Function R2D(Radians) As Double
    R2D = 57.2957795130823 * Radians
End Function

If anyone knows how to fix the selection or alignment issues (or both!) it would be greatly appreciated! If you know of a better way, happy to explore other options.

 

[Submeg]

So the reason my version above wasn't working: I was creating a string to select the shapes, not with an array.

Excel needs a comma delimited array to be able to do this, so I used the method below.

A follow up question: How could I use my original method to replicate the comma delimited array?

Dim ShapeNames() As String

'Call to a sub to ungroup any shapes.

'How many items are in each ring?
    
Ring1 = Range("B24").Value
Ring2 = Range("B25").Value
Ring3 = Range("B26").Value
Ring4 = Range("B27").Value

'Ring5 = Range("B28").Value
Ring5 = 1

'Once you know how many items are in the ring, determine the radius so they don't overlap.

'For each item, the radius increases by 7 and 5/6

Ring1R = Ring1 * (47 / 6)
Ring2R = Ring2 * (47 / 6)
Ring3R = Ring3 * (47 / 6)
Ring4R = Ring4 * (47 / 6)
Ring5R = Ring5 * (47 / 6)

'Ring1 - select

startIndex = 1
endIndex = Ring1


ReDim ShapeNames(1 To (endIndex - startIndex + 1))

For i = startIndex To endIndex
    ShapeNames(i - startIndex + 1) = "Item" & i
Next i


ActiveSheet.Shapes.Range(ShapeNames).Select

Call AlignShapesInCircle(625, 750, Ring1R, ActiveWindow.Selection.ShapeRange)

'Now group them.
Selection.ShapeRange.Group.Select
Selection.ShapeRange.Rotation = -90

'Ring 2 - select

startIndex = Ring1 + 1
endIndex = Ring1 + Ring2

ReDim ShapeNames(1 To (endIndex - startIndex + 1))

For i = startIndex To endIndex
    ShapeNames(i - startIndex + 1) = "Item" & i
Next i


ActiveSheet.Shapes.Range(ShapeNames).Select

Call AlignShapesInCircle(625, 750, Ring2R, ActiveWindow.Selection.ShapeRange)

'Now group them.
Selection.ShapeRange.Group.Select
Selection.ShapeRange.Rotation = -90