Question

我有两组我要链接的形状。

我选择好：

ModelAdmin

可以使用ActiveSheet.Shapes.Range(Array(type_of_milestone).Select

更改单个属性等

但是如何将它们与箭头连接器相关联？具体来说，我想将左侧的形状组的中间链接到右侧？

不确定如何将一组形状作为形状引用 - 如果这是可能的并且直接传递一组形状会引发错误

'Activewindow.selection.shaperange.groupitems(1).TextFrame.Characters.Text = name_of_milestone.

有什么想法吗？

宏从一系列预先绘制的组中选取，这些组是正方形，圆形和三角形，下面是文本，复制它，粘贴它，将其转储到新工作表上，重命名它，然后我只想将一个链接到下一个。是的，它在visio中可能会更好。

Answer 1

我不确定您是否可以从群组中绘制连接器。相反，我想建议一个替代解决方案：在形状组中添加不需要的形状，并在它们之间进行连接。

这是一个显示概念的快速黑客：

CreateHandles ActiveSheet.Shapes.Range(Array("Group 27"))

Sub CreateHandles(ShapeGroup)
    Dim MaxX As Long
    Dim MinX As Long
    Dim MaxY As Long
    Dim MinY As Long
    Dim Shp As Shape

    Dim LeftHandle As Shape
    Dim RightHandle As Shape

    MaxY = -1000000
    MinY = 1000000
    MaxX = -1000000
    MinX = 1000000

    For Each Shp In ShapeGroup
        If Shp.Top + Shp.Height > MaxY Then
            MaxY = Shp.Top + Shp.Height
        End If
        If Shp.Top < MinY Then
            MinY = Shp.Top
        End If
        If Shp.Left + Shp.Width > MaxX Then
            MaxX = Shp.Left + Shp.Width
        End If
        If Shp.Left < MinX Then
            MinX = Shp.Left
        End If
    Next
    Set LeftHandle = ActiveSheet.Shapes.AddShape(msoShapeRectangle, MinX, (MinY + MaxY) / 2, 10, 10) ' change the 10 to 0 once it works
    Set RightHandle = ActiveSheet.Shapes.AddShape(msoShapeRectangle, MaxX, (MinY + MaxY) / 2, 10, 10) ' change the 10 to 0 once it works
    ActiveSheet.Shapes.Range(Array(ShapeGroup.Name, LeftHandle.Name, RightHandle.Name)).Select
    Selection.ShapeRange.Group.Select

End Sub

我在这里做了更大的把手来展示这个概念。一旦工作，将大小设置为0。要解决的第二件事是底层的丑陋分组。

Answer 2

所以要回答我的问题，你不能连接组，只能连接形状。

我有一份里程碑列表，我会逐步查看。

诀窍是在具有唯一标识符的组中命名形状。 ActiveWindow.Selection.ShapeRange.GroupItems(2).Name = id_of_milestone

然后在我绘制了所有里程碑之后，运行以下链接（从里程碑水平从右侧到里程碑左侧的里程碑链接）

for i=1 to number_of_milestones Current_inc = i + 3 'because of row headers id_of_milestone = Sheets("Milestones").Range("P" & current_inc).Value 'assign the from value lookup_milestone = Sheets("Milestones").Range("P" & current_inc).Value 'assign the to value If lookup_milestone = "" Then 'check to see there actually is a link present, because it can be blank 'do nothing Else ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 1,1,1,1).Select Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes(id_of_milestone), 4 Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes(lookup_milestone), 2 End If

Excel VBA - 使用连接器连接分组的形状

2 个答案: