如何解决在Excel中连接形状的VBA标识
我正在尝试在Excel中开发VBA解决方案,该解决方案可以识别通过标准连接器线在工作表中相互连接的形状。
例如,在所附的代码段中,我需要创建一个代码,以标识控制方块已连接到两个红色圆圈(标题为Risk 1和Risk 2),并在消息框中输出以下内容:“风险1和风险2连接到控件”。我已经能够找到添加连接线的代码,但是我无法弄清楚如何识别连接的形状。任何指导将不胜感激!我还附加了到目前为止可以找到的代码。
Post
解决方法
因此,您需要遍历所有形状,检查它们是否是连接器(是的,连接器线也是形状)。然后您可以检查此连接线连接了哪些形状:
属性.ConnectorFormat.BeginConnectedShape
为连接器线的一端提供形状,而.ConnectorFormat.EndConnectedShape
为另一端的形状。
结帐:
Option Explicit
Public Sub TestConnections()
Dim shp As Variant
For Each shp In Shapes 'loop through all shapes
If shp.Connector = msoTrue Then 'check if current shape is a connector
'BeginConnectedShape is the shape on the beginning side of the connector
'EndConnectedShape is the shape on the ending side of the connector
Debug.Print shp.Name _
& " connects " & _
shp.ConnectorFormat.BeginConnectedShape.Name _
& " with " & _
shp.ConnectorFormat.EndConnectedShape.Name
End If
Next shp
End Sub
对于以下形状
它输出
Curved Connector 3 connects Cube 1 with Can 2
Curved Connector 6 connects Cube 5 with Can 2
,
您可以使用ConnectorFormat.EndConnectedShape property (Excel)和ConnectorFormat.BeginConnectedShape property (Excel)来实现所需的目标。
逻辑:
- 遍历所有连接器形状。
- 创建与其他形状连接的唯一形状集合。
- 获取开始和结束形状名称。
- 找到关系,即WHO与WHO之间有联系。
代码:
我已经注释了代码,但是如果您还有问题,请随时提出。
Option Explicit
'~~> Change this if your shapes include the below text
Const mySep As String = "MySep"
Sub Sample()
Dim ws As Worksheet
Dim shpConnector As Shape
Dim shpConnectorCount As Long
Dim i As Long: i = 1
Dim tmpAr As Variant,itm As Variant
Dim colConnector As New Collection
Dim msg As String
Dim finalOutput As String
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Count the number of connector shapes
For Each shpConnector In .Shapes
If shpConnector.Connector Then shpConnectorCount = shpConnectorCount + 1
Next shpConnector
'~~> If not found then exit sub
If shpConnectorCount = 0 Then Exit Sub
'~~> Resize array based on connector count
ReDim tmpAr(1 To shpConnectorCount)
For Each shpConnector In .Shapes
With shpConnector
If .Connector Then
'~~> Unique collection of shapes to which other
'~~> shapes are connected with
On Error Resume Next
colConnector.Add CStr(.ConnectorFormat.EndConnectedShape.Name),_
CStr(.ConnectorFormat.EndConnectedShape.Name)
On Error GoTo 0
'~~> Store Starting shape and End Shape in an array
tmpAr(i) = .ConnectorFormat.BeginConnectedShape.Name & mySep _
& .ConnectorFormat.EndConnectedShape.Name
i = i + 1
End If
End With
Next
'~~> Loop through the unique collection and the array to create
'~~> Our necessary output
For Each itm In colConnector
msg = ""
For i = LBound(tmpAr) To UBound(tmpAr)
If Split(tmpAr(i),mySep)(1) = itm Then
msg = msg & "," & Split(tmpAr(i),mySep)(0)
End If
Next i
finalOutput = finalOutput & vbNewLine & Mid(msg,2) & " is/are connected to " & itm
Next itm
End With
MsgBox Mid(finalOutput,2)
End Sub
行动中:
屏幕截图:
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。