Vba Excel 2013在两个不同组上的任意点之间添加连接器

我正在使用Excel 2013（以编程方式）在矩形的右下角之间添加一个直线连接件，该矩形是分组形状的一部分，其端点是一系列分组线段。目前，我甚至无法在包含这些形状的Excel工作表上手动执行此操作

问题包括：

只有所需矩形上的中点才能接受连接器

分组的一系列线段甚至不显示直线连接器终端的“连接点”

下面是我正在尝试做的图形：

[我没有10个“声望点数”，所以我似乎无法发布我正在尝试做的事情的图片。这不是一个特别有用的功能！我如何在这个游戏中获得声望点数？]

我已经能够创建并命名这两个组，并认为与它们一起添加连接器是轻而易举的事，但事实并非如此

以下是我一直使用的代码：

Sub create_new_profile()
    Dim firstRect As Shape
    Dim firstLine As Shape
    Set myDocument = Worksheets(1)
    Set s = myDocument.Shapes
'    Set firstRect = s.Range("shpNewGarage")
'    Set firstLine = s.Range("shpProfile")
    Dim Shp As Shape
'    For Each Shp In myDocument.Shapes
    For Each Shp In s
        If Shp.Name = "shpNewGarage" Then
            Set firstRect = Shp
    Else
    End If
    Next Shp
'    For Each Shp In myDocument.Shapes
    For Each Shp In s
        If Shp.Name = "shpProfile" Then
            Set firstLine = Shp
    Else
    End If
    Next Shp
    firstRect.Select 'this works
    firstLine.Select 'this works
'    Set firstRect = s.AddShape(msoShapeRectangle, 100, 50, 200, 100)
'    Set firstLine = s.AddShape(msoShapeRectangle, 300, 300, 200, 100)
'    Set firstRect = ActiveSheet.Shapes.Range("shpNewGarage")
'    Set firstLine = ActiveSheet.Shapes.Range("shpProfile")
    Dim c As Shape
    Set c = s.AddConnector(msoConnectorStraight, 0, 0, 100, 100)
'    On Error Resume Next
    With c.ConnectorFormat
      **.BeginConnect ConnectedShape:=firstRect, ConnectionSite:=1**
      .EndConnect ConnectedShape:=firstLine, ConnectionSite:=1
'     .BeginConnect ConnectedShape:="shpNewGarage", ConnectionSite:=1
'     .EndConnect ConnectedShape:="shpProfile", ConnectionSite:=1
'     .BeginConnect ConnectedShape:=ActiveSheet.Shapes.Range("shpNewGarage"), ConnectionSite:=1
'     .EndConnect ConnectedShape:=ActiveSheet.Shapes.Range("shpProfile"), ConnectionSite:=1
     c.RerouteConnections
    End With
End Sub

此特定版本的代码在紧跟着行的行上以运行时错误结束：

使用c.ConnectorFormat

以下是错误消息：

[我没有10个“声誉点数”，因此我似乎无法发布我收到的错误消息的图片。再说一次，我如何获得声誉点数？]

任何能帮助我以编程方式完成这项任务的指导都将不胜感激

谢谢你解释我现在可以发布图片了。这应该会有帮助

以下是我正在处理的数据：

Sub create_new_profile()
    Dim firstRect As Shape
    Dim firstLine As Shape
    Set myDocument = Worksheets(1)
    Set s = myDocument.Shapes
'    Set firstRect = s.Range("shpNewGarage")
'    Set firstLine = s.Range("shpProfile")
    Dim Shp As Shape
'    For Each Shp In myDocument.Shapes
    For Each Shp In s
        If Shp.Name = "shpNewGarage" Then
            Set firstRect = Shp
    Else
    End If
    Next Shp
'    For Each Shp In myDocument.Shapes
    For Each Shp In s
        If Shp.Name = "shpProfile" Then
            Set firstLine = Shp
    Else
    End If
    Next Shp
    firstRect.Select 'this works
    firstLine.Select 'this works
'    Set firstRect = s.AddShape(msoShapeRectangle, 100, 50, 200, 100)
'    Set firstLine = s.AddShape(msoShapeRectangle, 300, 300, 200, 100)
'    Set firstRect = ActiveSheet.Shapes.Range("shpNewGarage")
'    Set firstLine = ActiveSheet.Shapes.Range("shpProfile")
    Dim c As Shape
    Set c = s.AddConnector(msoConnectorStraight, 0, 0, 100, 100)
'    On Error Resume Next
    With c.ConnectorFormat
      **.BeginConnect ConnectedShape:=firstRect, ConnectionSite:=1**
      .EndConnect ConnectedShape:=firstLine, ConnectionSite:=1
'     .BeginConnect ConnectedShape:="shpNewGarage", ConnectionSite:=1
'     .EndConnect ConnectedShape:="shpProfile", ConnectionSite:=1
'     .BeginConnect ConnectedShape:=ActiveSheet.Shapes.Range("shpNewGarage"), ConnectionSite:=1
'     .EndConnect ConnectedShape:=ActiveSheet.Shapes.Range("shpProfile"), ConnectionSite:=1
     c.RerouteConnections
    End With
End Sub

矩形组（firstRect，“shpNewGarage”）表示我计划在现有车库和街道之间修建的新车库。纵断面组（第一行，“shpProfile”）表示现有车道（浅蓝色线）的纵断面（侧视图/立面）。其想法是将新纵断面（红线）连接到新车库右下角的一端和现有纵断面（路缘）的右端，以便在我上下移动新车库时，在右侧和左侧，表示新纵断面的连接件将保持附着在这些点上，以图形方式显示新车道的角度（坡率）和长度

以下是我运行代码时收到的错误消息：

这看起来像是一座很难攀登的山，因为我甚至在手动将连接器添加到所需的点时都遇到了问题

---

感谢所有阅读/回复我的问题的人。Stackoverflow在过去对我来说是一个很好的资源，这是我第一次不得不发布我自己的相当具体的问题。

你解释得很好，你上传的图片对我很有帮助

您的代码所做的似乎是正确的，但错误在于其中一个参数，可能是第二个参数：

.BeginConnect ConnectedShape:=firstRect，ConnectionInSite:=1

ConnectionSite:“ConnectedShape指定的形状上的连接站点。必须是介于1和指定形状的ConnectionSiteCount属性返回的整数之间的整数”

我认为您的firstRect与第一个节点有一个问题：当您最初生成一个矩形时，它的角点中没有连接点，并且我不确定初始可用节点

矩形是必须首先转换为（通用）形状类的特定形状类：“在使用ConvertToShape方法之前，必须将AddNodes方法至少应用于FreeformBuilder对象一次”，以便将连接点（节点）添加到角点

另一个问题可能是由团体引起的。我不确定是否对对象进行了分组，但分组可能不允许直接访问连接点

作为练习，我能够按照您所希望的方式在两个矩形之间绘制线，但我的线实际上没有连接到形状，因此如果移动一个矩形，线将不会随之移动。这是我的密码：

Option Explicit

Sub create_new_profile()

    Dim ws As Worksheet

    Dim shp1 As Shape
    Dim shp2 As Shape

    Dim line1 As Shape
    Dim line2 As Shape

    Set ws = Sheet1

    With ws.Shapes

        'AddShape:        Left=10, Top=10, Width=50, Height=30
        Set shp1 = .AddShape(msoShapeRectangle, 10, 10, 50, 30)
        Set shp2 = .AddShape(msoShapeRectangle, 70, 50, 50, 30)

        'AddConnector:          BeginX=60, BeginY=10, EndX=120, EndY=50
        Set line1 = .AddConnector(msoConnectorStraight, 60, 10, 120, 50)
        Set line2 = .AddConnector(msoConnectorStraight, 60, 40, 120, 80)
    End With

    line1.Line.ForeColor.RGB = RGB(255, 0, 0)   'Color Red
    line2.Line.ForeColor.RGB = RGB(255, 0, 0)

End Sub

这就是最终结果：

如果需要将线链接到矩形，则必须将矩形转换为形状，然后添加角连接点或节点（msoEditingCorner），然后添加从第一个矩形的一个角节点到第二个矩形的另一个角节点的连接线

（手动）转换为形状并记录操作以查看生成的VBA代码和使用的对象的方法之一是右键单击形状并选择“编辑点”：

---

希望这有点帮助

形状的图像会有帮助（至少对我来说-我想手动完成）。我认为你的声誉上升到了11-你的问题得到了投票。你能再次上传图片吗？我以前没有使用过此功能，但我认为您必须首先对元素进行解组，才能访问每个元素的端点。此信息大大增加了我对形状和连接器的理解。我已经为我正在做的事情开发了一个解决方法，基本上可以避免无法连接到矩形角（“股票”的，无论如何）和线段的问题。我在底部“车库”矩形的底部段周围创建了一个矩形，在“路缘”（车道纵断面右端终止的地方）创建了一个矩形。然后，我手动在新矩形的适当侧面之间添加了一个红色接头，使两个矩形都不可见，然后将左矩形与车库的其余部分分组。这很有效，太好了！最终的结果才是最重要的，同时也学到了一些新的东西：）是否有任何方法可以编辑点或在ex.conn1.ConnectorFormat.BeginConnect shap1，1.的第一个连接旁边添加连接。。我有类似这样的东西，如果我在点1的下一个连接，但是在连接1的旁边。