Grouping and naming shapes in Excel with vba - vba

Question

In Excel vba, I am creating two shapes in excel using vba. An arrow, which I name "aro" + i, and a textbox, which I name "text" + i, where i is a number indicating the number of a photograph.
So, say for photograph 3 I will creat arrow "aro3" and textbox "text3".
I then want to group them and rename that group "arotext" + i, so "arotext3" in this instance.
So far I have been doing the grouping and renaming like this:
targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name)).Select
Selection.group
Selection.Name = "AroTxt" & Number
which works splendidly in a sub, but now I want to change this into a function and return the named group, so I tried something like this:
Dim arrowBoxGroup as Object
set arrowBoxGroup = targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name))
arrowBoxGroup.group
arrowBoxGroup.Name = "AroTxt" & Number
I run into problems when I create a new group which has the same name as one which has already been created. So, if I create a second "aro3" and "text3" and then try to group them and rename the group to "arotext3" I get an error because a group with the same name is already present.
The thing I don't understand is that when I did this using the method referring to the selection, I could rename every group with the same name if I wanted and wouldn't get an error. Why does it work when referring to the Selection object, but fails when trying to use an assigned object?
UPDATE:
Since somebody asked, the code I have so far is below. arrow and textbox are an arrow and a textbox which point into a direction arbitrarily defined by the user using a form.
This then creates an arrow at the correct angle on the target worksheet and places a textbox with the specified number (also through the form) at the end of the arrow, so that it effectively forms a callout. I know that there are callouts, but they don't do what I want so I had to make my own.
I have to group the textbox and arrow because 1) they belong together, 2) I keep track of which callouts have already been placed using the group's name as a reference, 3) the user has to place the callout in the right location on a map which is embedded in the worksheet.
So far I have managed to make this into a function by making the return value a GroupObject. But this still relies on Sheet.Shapes.range().Select, which in my opinion is a very bad way of doing this. I am looking for a way which does not rely on the selection object.
And I would like to understand why this works when using selection, but fails when using strong typed variables to hold the objects.
Public Function MakeArrow(ByVal No As Integer, ByVal angle As Double, ByVal size As ArrowSize, ByVal ArrowX As Double, ByVal ArrowY As Double, ByVal TargetInternalAngle As Double, ByRef targetSheet As Worksheet) As GroupObject
Dim Number As String
Dim fontSize As Integer
Dim textboxwidth As Integer
Dim textboxheight As Integer
Dim arrowScale As Double
Dim X1 As Double
Dim Y1 As Double
Dim X2 As Double
Dim Y2 As Double
Dim xBox As Double
Dim yBox As Double
Dim testRange As Range
Dim arrow As Shape
Dim textBox As Shape
' Dim arrowTextbox As ShapeRange
' Dim arrowTextboxGroup As Variant
Select Case size
Case ArrowSize.normal
fontSize = fontSizeNormal
arrowScale = arrowScaleNormal
Case ArrowSize.small
fontSize = fontSizeSmall
arrowScale = arrowScaleSmall
Case ArrowSize.smaller
fontSize = fontSizeSmaller
arrowScale = arrowScaleSmaller
End Select
arrowScale = baseArrowLength * arrowScale
'Estimate required text box width
Number = Trim(CStr(No))
Set testRange = shtTextWidth.Range("A1")
testRange.value = Number
testRange.Font.Name = "ＭＳ Ｐ明朝"
testRange.Font.size = fontSize
shtTextWidth.Columns(testRange.Column).EntireColumn.AutoFit
shtTextWidth.Columns(testRange.row).EntireRow.AutoFit
textboxwidth = testRange.Width * 0.8
textboxheight = testRange.Height * 0.9
testRange.Clear
'Make arrow
X1 = ArrowX
Y1 = ArrowY
X2 = X1 + arrowScale * Cos(angle)
Y2 = Y1 - arrowScale * Sin(angle)
Set arrow = AddArrow(X1, Y1, X2, Y2, Number, targetSheet)
'Make text box
Set textBox = Addtextbox(angle, Number, fontSize, X2, Y2, textboxwidth, textboxheight, TargetInternalAngle, targetSheet)
'Group arrow and test box
targetSheet.shapes.Range(Array(arrow.Name, textBox.Name)).group.Select
Selection.Name = "AroTxt" & Number
Set MakeArrow = Selection
' Set arrowTextbox = targetSheet.shapes.Range(Array(arrow.Name, textBox.Name))
' Set arrowTextboxGroup = arrowTextbox.group
' arrowTextboxGroup.Name = "AroTxt" & Number
'
' Set MakeArrow = arrowTextboxGroup
End Function
Private Function AddArrow(ByVal StartX As Double, ByVal StartY As Double, ByVal EndX As Double, ByVal EndY As Double, ByVal Number As String, ByRef targetSheet As Worksheet) As Shape
Set AddArrow = targetSheet.shapes.AddLine(StartX, StartY, EndX, EndY)
With AddArrow
.Name = "Aro" & Number
With .Line
.BeginArrowheadStyle = msoArrowheadTriangle
.BeginArrowheadLength = msoArrowheadLengthMedium
.BeginArrowheadWidth = msoArrowheadWidthMedium
.ForeColor.RGB = RGB(0, 0, 255)
End With
End With
End Function
Private Function Addtextbox(ByVal angle As Double, ByVal Number As String, ByVal fontSize As Integer, ByVal arrowEndX As Double, ByVal arrowEndY As Double, ByVal Width As Integer, ByVal Height As Integer, ByVal LimitAngle As Double, ByRef targetSheet As Worksheet) As Shape
Dim xBox, yBox As Integer
Dim PI As Double
Dim horizontalAlignment As eTextBoxHorizontalAlignment
Dim verticalAlignment As eTextBoxVerticalAlignment
PI = 4 * Atn(1)
If LimitAngle = 0 Then
LimitAngle = PI / 4
End If
Select Case angle
'Right
Case 0 To LimitAngle, 2 * PI - LimitAngle To 2 * PI
xBox = arrowEndX
yBox = arrowEndY - Height / 2
horizontalAlignment = eTextBoxHorizontalAlignment.left
verticalAlignment = eTextBoxVerticalAlignment.Center
'Top
Case LimitAngle To PI - LimitAngle
xBox = arrowEndX - Width / 2
yBox = arrowEndY - Height
horizontalAlignment = eTextBoxHorizontalAlignment.Middle
verticalAlignment = eTextBoxVerticalAlignment.Bottom
'Left
Case PI - LimitAngle To PI + LimitAngle
xBox = arrowEndX - Width
yBox = arrowEndY - Height / 2
horizontalAlignment = eTextBoxHorizontalAlignment.Right
verticalAlignment = eTextBoxVerticalAlignment.Center
'Bottom
Case PI + LimitAngle To 2 * PI - LimitAngle
xBox = arrowEndX - Width / 2
yBox = arrowEndY
horizontalAlignment = eTextBoxHorizontalAlignment.Middle
verticalAlignment = eTextBoxVerticalAlignment.top
End Select
Set Addtextbox = targetSheet.shapes.Addtextbox(msoTextOrientationHorizontal, xBox, yBox, Width, Height)
With Addtextbox
.Name = "Txt" & Number
With .TextFrame
.AutoMargins = False
.AutoSize = False
.MarginLeft = 0#
.MarginRight = 0#
.MarginTop = 0#
.MarginBottom = 0#
Select Case verticalAlignment
Case eTextBoxVerticalAlignment.Bottom
.verticalAlignment = xlVAlignBottom
Case eTextBoxVerticalAlignment.Center
.verticalAlignment = xlVAlignCenter
Case eTextBoxVerticalAlignment.top
.verticalAlignment = xlVAlignTop
End Select
Select Case horizontalAlignment
Case eTextBoxHorizontalAlignment.left
.horizontalAlignment = xlHAlignLeft
Case eTextBoxHorizontalAlignment.Middle
.horizontalAlignment = xlHAlignCenter
Case eTextBoxHorizontalAlignment.Right
.horizontalAlignment = xlHAlignRight
End Select
With .Characters
.Text = Number
With .Font
.Name = "ＭＳ Ｐ明朝"
.FontStyle = "標準"
.size = fontSize
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End With
End With
.Fill.Visible = msoFalse
.Fill.Solid
.Fill.Transparency = 1#
With .Line
.Weight = 0.75
.DashStyle = msoLineSolid
.style = msoLineSingle
.Transparency = 0#
.Visible = msoFalse
End With
End With
End Function

Answer 1

Range.Group returns a value. You might try:
Set arrowBoxRange = targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name))
Set arrowBoxGroup = arrowBoxRange.Group
arrowBoxGroup.Name = "AroTxt" & Number
I suspect that the current Selection gets updated as if the following in your earlier work:
Set Selection = Selection.Group 'it's as if this is done for you when you create the group.
which is causing the difference.
FYI, I'm using Excel 2010 and cannot duplicate the original code snippet based on Selection (I get an error doing "Selection.Name = ", which gives object does not support property.)
Ok, I can get this to work:
Selection.Group.Select
Selection.Name = "AroTxt"
Of course, like the other snippet I suggest, this reassigns the group's return value, so that Selection in Selection.Group and Selection.Name are referring to different objects, which I think is what you want.

Answer 2

It is because you are storing the new groups as an object manually now that this error has appeared. You probably are not able to do anything with the multiple instances of "AroTxt" & Number that you have created. As excel wouldn't be able to decide which group you mean.
Excel shouldn't allow this but it doesn't always warn that this has happened but will error if you try to select a group that has a duplicate name.
Even if this isn't the case, it isn't good practice to have duplicate variable names. Would it not be better to add the extra Arrow's and textBox's to the group?
So to solve your problem you will have to check to see if the group already exists before you save it. Maybe delete it if exists or add to the group.
Hope this helps

Answer 3

Edit: As it always seems to go, the error started popping up after I clicked submit. I'll tinker around a bit more, but will echo #royka in wondering if you really do need to give the same name to multiple shapes.
The below code seems to do what you're looking for (create the shapes, give them names and then group). In the grouping function, I left the "AroText" number the same just to see if an error would happen (it did not). It seems that both shapes have the same name, but what differentiates them is their Shape.ID. From what I can tell, if you say ActiveSheet.Shapes("My Group").Select, it will select the element with that name with the lowest ID (as to why it lets you name two things the same name, no clue :) ).
It isn't quite an answer to your question of "why" (I wasn't able to replicate the error), but this will hopefully give you one way "how".
Sub SOTest()
Dim Arrow As Shape
Dim TextBox As Shape
Dim i as Integer
Dim Grouper As Variant
Dim ws As Worksheet
Set ws = ActiveSheet
' Make two shapes and group, naming the group the same in both cases
For i = 1 To 2
' Create arrow with name "Aro" & i
Set Arrow = ws.Shapes.AddShape(msoShapeRightArrow, 10, 50, 30, 30)
Arrow.Name = "Aro" & i
' Create text box with name "Text" & i
Set TextBox = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 40, 40)
TextBox.Name = "Text" & i
' Use a group function to rename the shapes
Set Grouper = CreateGroup(ws, Arrow, TextBox, i)
' See the identical names but differing IDs
Debug.Print "Name: " & Grouper.Name & " | ID: " & Grouper.ID
Next
End Sub
Function CreateGroup(ws As Worksheet, Arrow As Shape, TextBox As Shape, Number As Integer) As Variant
Dim arrowBoxGroup As Variant
' Group the provided shapes and change the name
Set arrowBoxGroup = ws.Shapes.Range(Array(Arrow.Name, TextBox.Name)).Group
arrowBoxGroup.Name = "AroTxt" & Number
' Return the grouped object
Set CreateGroup = arrowBoxGroup
End Function