在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)来实现所需的目标。

逻辑：

1. 遍历所有连接器形状。
2. 创建与其他形状连接的唯一形状集合。
3. 获取开始和结束形状名称。
4. 找到关系，即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

行动中：

屏幕截图：