我在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"声望点"所以我似乎无法发布我正在收到的错误消息的图片。再次,我如何获得声望点?]
任何有助于我以编程方式完成此任务的方向都将非常感激。
感谢您解释我现在可以发布图片了。这应该会有所帮助。
以下是我与之合作的数据:
矩形组(firstRect," shpNewGarage")代表我计划在现有的和街道之间建造的新车库。配置文件组(firstLine," shpProfile")表示现有车道(浅蓝色线)的轮廓(侧视图/高程)。想法是将新轮廓(红线)附加到下方新车库的右一端和现有轮廓(路缘)的右端,这样当我向上,向下,向右和向左移动新车库时,代表新轮廓的连接器将保持连接到这些点到以图形方式显示新车道的角度(坡度)和长度。
这是我运行代码时收到的错误消息:
这看起来很像爬山,因为即使手动将连接器添加到所需的点也存在问题。
感谢所有阅读/回复我的问题的人。 Stackoverflow过去对我来说是一个很好的资源,这是我第一次发布自己相当具体的问题。
答案 0 :(得分:1)
你很好地解释了一切,你上传的图片帮助了
您的代码正在做什么似乎是正确的,但错误是抱怨其中一个参数,它可能是第二个:
.BeginConnect ConnectedShape:= firstRect, ConnectionSite:= 1
ConnectionSite:“ ConnectedShape指定的形状上的连接站点。必须是介于1和指定形状的ConnectionSiteCount属性返回的整数之间的整数”
我认为你的firstRect第一个节点有问题:当你最初生成一个矩形时,它没有角落里的连接点,我不确定初始可用节点
矩形是必须首先转换为(通用)形状类的特定形状类:“在使用ConvertToShape方法之前,必须至少将一次AddNodes方法应用于FreeformBuilder对象“,以便将连接点(节点)添加到角落
另一个问题可能是由群组造成的。我不确定您是否对对象进行分组,但分组可能不允许直接访问连接点
作为练习,我能够按照你想要的方式在2个矩形之间绘制线条,但是我的线条实际上并没有连接到形状,所以如果我移动一个矩形,线条就不会随之移动。这是我的代码:
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代码和使用的对象的方法之一是:
希望这有点帮助