Option Explicit
Public Sub Bsp()
Dim col As VBA.Collection
Dim shp As Word.Shape
If GetConnectors(col, ThisDocument) > 0 Then
For Each shp In col
With shp.ConnectorFormat
If .BeginConnected And shp.ConnectorFormat.EndConnected Then
Debug.Print "connector '" & shp.Name & "' between '" & .BeginConnectedShape.Name & "' and '" & .EndConnectedShape.Name & "'"
ElseIf .BeginConnected And Not .EndConnected Then
Debug.Print "connector '" & shp.Name & "' between '" & .BeginConnectedShape.Name & "' and <none>"
ElseIf Not .BeginConnected And .EndConnected Then
Debug.Print "connector '" & shp.Name & "' between <none> and '" & .EndConnectedShape.Name & "'"
Else
Debug.Print "connector '" & shp.Name & "' between <none> and <none>"
End If
End With
Next
End If
End Sub
Public Function GetConnectors(ByRef Connectors As VBA.Collection, Optional ByVal Document As Word.Document) As Long
If Document Is Nothing _
Then Set Document = ActiveDocument
Dim colConn As VBA.Collection
Dim shpCanvas As Word.Shape
Dim shp As Word.Shape
For Each shp In Document.Shapes
If shp.Type = msoCanvas Then
Set shpCanvas = shp
Exit For
End If
Next
If shpCanvas Is Nothing Then Exit Function
Set Connectors = New VBA.Collection
For Each shp In shpCanvas.CanvasItems
If shp.Connector Then
Call Connectors.Add(Key:=shp.Name, Item:=shp)
End If
Next
GetConnectors = Connectors.Count
End Function