Thema Datum  Von Nutzer Rating
Antwort
28.04.2014 16:34:13 Corina
NotSolved
28.04.2014 17:31:35 Gast66399
NotSolved
29.04.2014 09:05:24 Corina
NotSolved
Blau Konnektor verbindet das Ende nicht
29.04.2014 12:19:16 Gast58210
NotSolved
29.04.2014 12:29:18 Gast58210
NotSolved
29.04.2014 13:04:44 Gast93132
NotSolved
29.04.2014 13:11:11 Gast42193
*****
Solved
29.04.2014 14:35:21 Corina
NotSolved
Rot Ok
29.04.2014 18:25:38 Gast80647
NotSolved
30.04.2014 09:01:00 Corina
NotSolved
30.04.2014 09:23:15 Corina
NotSolved
30.04.2014 14:18:11 Gast46487
NotSolved

Ansicht des Beitrags:
Von:
Gast58210
Datum:
29.04.2014 12:19:16
Views:
1097
Rating: Antwort:
  Ja
Thema:
Konnektor verbindet das Ende nicht

Hi Corina,

 

ich hab mal ein Beispiel erstellt, eines das entgegen meiner gestrigen Beschreibung vereinfacht wurde (ist allerdings dann auch nicht so schnell wie die andere Variante, aber wird vermutlich genügen).

Du übergibts das gewünschte Shape der Hilfsfunktion GetShapeConnectors und diese liefert dir die Connectoren die mit diesem Shape verbunden sind. Wenn es keine gibt, ist die Anzahl Null (0).

Auf dem Bild kann ich leider nicht erkennen was was ist. Die haben alle abgerundete Ecken. So ist "Risk Events" zum Beispiel gleichzeitig Anfangspunkt (2 mal) und Endpunkt (1mal).

 

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

Gruß


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
28.04.2014 16:34:13 Corina
NotSolved
28.04.2014 17:31:35 Gast66399
NotSolved
29.04.2014 09:05:24 Corina
NotSolved
Blau Konnektor verbindet das Ende nicht
29.04.2014 12:19:16 Gast58210
NotSolved
29.04.2014 12:29:18 Gast58210
NotSolved
29.04.2014 13:04:44 Gast93132
NotSolved
29.04.2014 13:11:11 Gast42193
*****
Solved
29.04.2014 14:35:21 Corina
NotSolved
Rot Ok
29.04.2014 18:25:38 Gast80647
NotSolved
30.04.2014 09:01:00 Corina
NotSolved
30.04.2014 09:23:15 Corina
NotSolved
30.04.2014 14:18:11 Gast46487
NotSolved