Excel 2013在两个不同组的任意点之间添加连接器 [英] Excel 2013 Add a Connector Between Arbitrary Points on Two Different Groups

问题描述

我正在Excel 2013中(以编程方式)在作为分组形状一部分的矩形的右下角与一组线段的端点之间添加直线连接器.就目前而言，我什至似乎都无法在包含这些形状的Excel工作表上手动进行此操作.

I'm working in Excel 2013 to (programmatically) add a straight line connector between the lower right hand corner of a rectangle that is part of a grouped shape with the endpoint of a grouped series of line segments. As it stands, I can't even seem to do this manually on the Excel worksheet that contains these shapes.

问题包括:

1. 仅所需矩形上的中点会接受连接器.
2. 分组的线段系列甚至没有在直线连接器的终端显示连接点".

以下是我要执行的操作的图形:

Here's a graphic of what I'm trying to do:

[我没有10个声誉点"，因此我似乎无法张贴自己想要做的事情的图片.这不是一个特别有用的功能！如何在此游戏中获得声望点?]

[I don't have 10 "reputation points" so I can't seem to post a picture of what I'm trying to do. Not an especially helpful feature! How do I get reputation points in this game?]

我已经能够创建并命名这两个组，并认为与他们一起添加连接器会很麻烦，但事实并非如此.

I've been able to create and name the two groups and thought it would be a cinch to work with them to add a connector, but that has not been the case.

这是我一直在使用的代码:

Here's the code I've been working with:

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

此特定版本的代码在紧随其后的行上以运行时错误结尾:

This particular version of the code ends with a runtime error on the line immediately following the line:

使用c.ConnectorFormat

With c.ConnectorFormat

这是错误消息:

[我没有10个信誉点"，所以我似乎无法张贴所收到的错误消息的图片.同样，我如何获得声望点?]

[I don't have 10 "reputation points" so I can't seem to post a picture of the error message I'm getting. Again, how do I get reputation points?]

任何能帮助我以编程方式完成此任务的方向，将不胜感激.

Any direction at all to help me accomplish this task programmatically would be greatly appreciated.

感谢您解释说我现在可以发布图像了.那应该有帮助.

Thanks for explaining that I can now post images. That should help.

以下是我正在使用的数字:

Here are the figures I'm working with:

矩形组(firstRect，"shpNewGarage")代表了我计划在现有车库和街道之间建造的新车库.纵断面组(firstLine，"shpProfile")表示现有车道的纵断面(侧视图/高程)(浅蓝色线).其想法是将新的纵断面(红线)附加到新车道的右下角.车库位于现有轮廓(路缘)的一端和右端，因此当我上下左右移动新车库时，代表新轮廓的连接器将保持与这些点的连接，以图形方式显示角度(坡度)和新车道的长度.

The rectangle group (firstRect, "shpNewGarage") represents a new garage I plan to build between the existing one and the street. The profile group (firstLine, "shpProfile") represents the profile (side view/elevation) of the existing driveway (the light blue line.) The idea is to attach the new profile (red line) to the lower right corner of the new garage at one end and to the right end of the existing profile (curb) so that as I move the new garage up, down, right and left, the connector representing the new profile will remain attached to these points to show graphically the angle (grade) and length of the new driveway.

这是运行代码时收到的错误消息:

Here's the error message I receive when I run the code:

这看起来像是要爬的一座小山，因为我什至无法手动将连接器添加到所需的点上.

This looks like quite a hill to climb, as I am having problems even adding the connector to the desired points manually.

感谢所有阅读/回复我的问题的人.过去，Stackoverflow一直是我的宝贵资源，这是我第一次必须发布自己的相当具体的问题.

Thanks to all who have read/responded to my issue. Stackoverflow has been a great resource to me in the past, and this is the first time I've ever had to post my own fairly specific problem.

推荐答案

您对所有内容都进行了很好的解释，上载的图像也有帮助

You explained everything very well, and the images you uploaded helped

您的代码正在执行的操作似乎是正确的，但是错误是在抱怨其中一个参数，它可能是第二个参数:

What your code is doing seems to be correct, but the error is complaining about one of the parameters, and it could be the 2nd one:

.BeginConnect ConnectedShape:= firstRect， ConnectionSite:= 1

.BeginConnect ConnectedShape:=firstRect, ConnectionSite:=1

ConnectionSite:"由ConnectedShape指定的形状上的连接位置.必须为1到指定形状的ConnectionSiteCount属性返回的整数之间的整数"

ConnectionSite: "A connection site on the shape specified by ConnectedShape. Must be an integer between 1 and the integer returned by the ConnectionSiteCount property of the specified shape"

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

I think your firstRect has a problem with the first Node: when you initially generate a rectangle it doesn't have connection points in the corners, and I'm not sure about the initial available nodes

矩形是特定的形状类别，必须首先将其转换为(通用)形状类别:"在使用ConvertToShape方法之前，必须至少对FreeformBuilder对象应用一次AddNodes方法"，以便将连接点(节点)添加到角落

A rectangle is a specific class of shape that must first be converted to a (generic) shape class: "You must apply the AddNodes method to a FreeformBuilder object at least once before you use the ConvertToShape method", in order to add connection points (nodes) to the corner

另一个问题可能是由组引起的.我不确定是否将对象分组，但是分组可能不允许直接访问连接点

Another issue might be caused by groups. I'm not sure if you grouped the objects, but grouping may not allow direct access to connection points

作为练习，我能够按照您想要的方式在2个矩形之间绘制线条，但是我的线条实际上并没有连接到形状，因此，如果我移动一个矩形，线条将不会随之移动.这是我的代码:

As an exercise, I was able to draw lines between 2 rectangles the way you intended, but my lines are not actually connected to the shapes, so if I move one rectangle the lines will not move with it. Here is my code:

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)，然后将第一个矩形的一个角节点的连接线添加到第二个矩形的另一个角节点

If you need the lines to be linked to the rectangles, you'll have to convert the rectangles to shapes, then add corner connection points or nodes (msoEditingCorner), then add connector lines from one corner node of the first rectangle to the other corner node of the second rectangle

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

One of the ways to (manually) convert to shape, and record your actions to see the generated VBA code and objects used, is by right-clicking the shape and selecting "Edit Points":

希望这会有所帮助

这篇关于Excel 2013在两个不同组的任意点之间添加连接器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！