Option Explicit
Sub test()
Dim colConn As VBA.Collection
Dim shp As Excel.Shape
For Each shp In ActiveSheet.Shapes
If shp.AutoShapeType = msoShapeRoundedRectangle Then
Set colConn = GetShapeConnectors(shp)
Debug.Print "Form '" & shp.Name & "' hat " & colConn.Count & " Verbindung(en)"
End If
Next
If colConn Is Nothing Then
Debug.Print "[-- keine Treffer --]"
End If
End Sub
Public Function GetShapeConnectors(Shape As Excel.Shape) As VBA.Collection
Dim shp As Excel.Shape
Dim shpChild As Excel.Shape
Set GetShapeConnectors = New VBA.Collection
For Each shp In Shape.Parent.Shapes
If shp.Connector Then
With shp.ConnectorFormat
If Shape.Type <> msoGroup Then
If .BeginConnectedShape Is Shape Then
Call GetShapeConnectors.Add(shp)
ElseIf .EndConnectedShape Is Shape Then
Call GetShapeConnectors.Add(shp)
End If
Else
For Each shpChild In Shape.GroupItems
If .BeginConnectedShape Is shpChild Then
Call GetShapeConnectors.Add(shp)
ElseIf .EndConnectedShape Is shpChild Then
Call GetShapeConnectors.Add(shp)
End If
Next
End If
End With
End If
Next
End Function