Databases
StackOverflow2013
Postsdbo
POGrouping and naming shapes in Excel with vba
 

Note that there are some explanatory texts on larger screens.

plurals
  1. POGrouping and naming shapes in Excel with vba
    primarykey
    data
    text
    <p>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.</p> <p>So, say for photograph 3 I will creat arrow "aro3" and textbox "text3".</p> <p>I then want to group them and rename that group "arotext" + i, so "arotext3" in this instance.</p> <p>So far I have been doing the grouping and renaming like this:</p> <pre><code>targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name)).Select Selection.group Selection.Name = "AroTxt" &amp; Number </code></pre> <p>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:</p> <pre><code>Dim arrowBoxGroup as Object set arrowBoxGroup = targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name)) arrowBoxGroup.group arrowBoxGroup.Name = "AroTxt" &amp; Number </code></pre> <p>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.</p> <p>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?</p> <p>UPDATE:</p> <p>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. </p> <p>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.</p> <p>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.</p> <p>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.</p> <p>And I would like to understand why this works when using selection, but fails when using strong typed variables to hold the objects.</p> <pre><code> 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" &amp; Number Set MakeArrow = Selection ' Set arrowTextbox = targetSheet.shapes.Range(Array(arrow.Name, textBox.Name)) ' Set arrowTextboxGroup = arrowTextbox.group ' arrowTextboxGroup.Name = "AroTxt" &amp; 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" &amp; 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" &amp; 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 </code></pre>
    singulars
    1. PO
      singulars
      1. PTAnswer
    1. This table or related slice is empty.
    1. PTQuestion
    1. USyu_ominae
    1. USyu_ominae
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. PO
      singulars
      1. PTAnswer
    2. PO
      singulars
      1. PTAnswer
    3. PO
      singulars
      1. PTAnswer
    1. VO
      singulars
      1. POGrouping and naming shapes in Excel with vba
      1. USyu_ominae
      1. VTBountyStart
    2. VO
      singulars
      1. POGrouping and naming shapes in Excel with vba
      1. This table or related slice is empty.
      1. VTUpMod
    3. VO
      singulars
      1. POGrouping and naming shapes in Excel with vba
      1. This table or related slice is empty.
      1. VTUpMod
    1. COI think you need to provide more details of what you have been trying in order to get som help. For instance, what is the Arrow and textBox objects and how do you assign them? Why do you need to group them?
      singulars
      1. POGrouping and naming shapes in Excel with vba
      1. USOlle Sjögren
    2. COBit of an update. I had to run the above code in Excel 2007 today and it broke on the Selection.Name bit. Maybe this only worked because of some bug in Excel 2003 (and previous?).
      singulars
      1. POGrouping and naming shapes in Excel with vba
      1. USyu_ominae
 

Querying!

 
Guidance
A row detail

Detail views are divided into sections. All the information in the data section comes from columns in the selected row. The other sections display data from other, related rows.

Related data can be related in a to-one or a to-many fashion. Captions of data related in a to-many fashion link to a list view showing a filtered view of the table.

Try moving around until you find a non-empty to-many entry and click on the label to get to one. You can move back to the root by clicking on the database name in the header.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload