用vba在Excel中分组和命名形状
在Excel VBA中，我使用VBA在Excel中创build两个形状。 一个箭头，我叫“aro”+ i，还有一个文本框，我把它命名为“text”+ i，其中i是一个表示照片编号的数字。
所以，照片3我会创build箭头“aro3”和文本框“text3”。
然后我想分组他们并重命名该组“arotext”+我，所以在这种情况下，“arotext3”。
到目前为止，我一直在做这样的分组和重命名：
targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name)).Select Selection.group Selection.Name = "AroTxt" & Number 它在一个子工作出色，但现在我想改变这个function，并返回指定的组，所以我尝试了这样的事情：
Dim arrowBoxGroup as Object set arrowBoxGroup = targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name)) arrowBoxGroup.group arrowBoxGroup.Name = "AroTxt" & Number
当我创build一个与已经创build的名称相同的新组时，我遇到了问题。 所以，如果我创build第二个“aro3”和“text3”，然后尝试将它们分组并重命名为“arotext3”我得到一个错误，因为具有相同名称的组已经存在。
我不明白的是，当我使用引用select的方法来完成这项工作时，如果我想要的话，我可以重命名每个组，并且不会出现错误。 为什么在引用Selection对象时工作，但在尝试使用分配的对象时失败？
更新：
既然有人问，我到目前为止的代码如下。 箭头和文本框是箭头和文本框，指向由用户使用表单任意定义的方向。
然后，在目标工作表上以正确的angular度创build一个箭头，并在箭头的末尾放置一个带有指定数字（也通过表单）的文本框，以便有效地形成标注。 我知道有一些标注，但他们没有做我想做的事情，所以我必须自己做。
我必须对文本框和箭头进行分组，因为1）它们属于一起，2）使用组名作为参考，logging已经放置了哪些标注，3）用户必须将标注放置在embedded在工作表中的地图。
到目前为止，我已经设法通过将返回值设置为一个GroupObject来实现这个function。 但是这仍然依赖于Sheet.Shapes.range（）。select，在我看来这是一个非常糟糕的方式做到这一点。 我正在寻找一种不依赖于select对象的方式。
我想了解为什么这个工作时使用select，但失败时使用强typesvariables来保存的对象。
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
Range.Group返回一个值。 你可以尝试：
Set arrowBoxRange = targetSheet.shapes.Range(Array(Arrow.Name, textBox.Name)) Set arrowBoxGroup = arrowBoxRange.Group arrowBoxGroup.Name = "AroTxt" & Number
我怀疑当前的select会更新，就像您在以前的工作中的以下内容一样：
Set Selection = Selection.Group 'it's as if this is done for you when you create the group.
这是造成差异。
仅供参考，我使用Excel 2010，不能复制基于select的原始代码片段（我得到一个错误做“Selection.Name =”，这使对象不支持属性。）
好吧，我可以得到这个工作：
Selection.Group.Select Selection.Name = "AroTxt"
当然，就像我build议的其他片段一样，这会重新分配组的返回值，以便Selection.Group和Selection.Name中的Selection指向不同的对象，我认为这是您想要的。
这是因为您现在手动存储新组作为对象，现在出现此错误。 您可能无法对您创build的多个“AroTxt”＆Number实例进行任何操作。 因为excel将无法决定你的意思。
Excel不应该允许这样做，但它并不总是警告发生了这种情况，但是如果您尝试select一个名称重复的组，则会出错。
即使情况并非如此，重复的variables名也不是好习惯。 将额外的箭头和文本框添加到组中会不会更好？
所以要解决你的问题，你必须检查，看看这个组是否已经存在，然后再保存它。 也许删除它，如果存在或添加到组。
希望这可以帮助
编辑：因为它似乎总是去，错误开始popup后，我点击提交。 我会补充一点，但会回应@royka想知道如果你真的需要给相同的名称，以多个形状。
下面的代码似乎做你正在寻找（创build形状，给他们的名字，然后组）。 在分组function中，我只留下了“AroText”数字，以查看是否会发生错误（它没有）。 看来这两个形状都有相同的名字，但区分它们的是他们的Shape.ID 。 从我可以告诉，如果你说ActiveSheet.Shapes("My Group").Select ，它将select具有最低的ID这个名称的元素（至于为什么它可以让你命名两个相同的名字，没有线索： ））。
这不是对“为什么”（我无法复制这个错误）的问题的回答，但是这将有希望给你一个“如何”的方法。
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