|
Ich bin der glücklichste Mensch der Welt:
Sub CheckConnections()
Dim colConn As VBA.Collection
Dim shp As Excel.Shape
For Each shp In Worksheets("Checklist Structure").Shapes
If shp.AutoShapeType = msoShapeRoundedRectangle Then
Set colConn = GetShapeConnectors(shp)
Debug.Print "Shape '" & shp.Name & "' has " & colConn.Count & " connection(s)"
If colConn.Count = 0 Then
Set cnct = Worksheets("Checklist Structure").Shapes.AddConnector(msoConnectorElbow, 5, 5, 5, 5)
With cnct
.Line.EndArrowheadStyle = msoArrowheadOpen
.ConnectorFormat.BeginConnect Worksheets("Checklist Structure").Shapes("Rounded Rectangle 46"), 2
.ConnectorFormat.EndConnect shp, 2
End With
End If
End If
Next
If colConn Is Nothing Then
Debug.Print "[-- no hits! --]"
End If
End Sub
Wunderbar!!! Vielen, vielen Dank! Über die Zuweisung der Verbindungen werde ich mir noch Gedanken machen, aber das Grundgerüst ist schon mal da. Bevor ich mich damit auseinandersetze, muss ich es ja erstma hinbekommen, dass die neuen Shapes auch an der richtigen Stelle plaziert werde. Mühsam ernährt sich das Eichhörnchen :D
Have a nice day!
|