Shape connectors

  • Thread starter Thread starter Davwe
  • Start date Start date
D

Davwe

I have made a decisionchart on an excelsheet. ( a flowchart with actions
and decisions and connectorlines between them)


Now I have written a macro that reads all shapes and puts the
properties in an array. But for each shape I also want to know to
which other shapes it is connected.

like

shape 1 name: Action1 connected to Decision1
shape 2 name: Decision1 connected to Decision2 and Action2
shape 3 name Decision2 connecter to Action3
etc

How can I do this

With mydocument.Shapes
For i = .Count To 1 Step -1

ActiveSheet.Shapes(i).Select
Tname(i) = ActiveSheet.Shapes(i).AlternativeText
Tconnect1(i) = ????
Tconnect2(i) = ????
Next
End With

see attached file

File Attached: http://www.exceltip.com/forum/attachment.php?postid=293427 (book1.xls)
 
Davwe

Below is some code that will find the paths to a particular shape. It
doesn't do what you ask, but you can get some of the proper properties and
methods to do what you want. I can send you the workbook if you like. Send
me a private email if you want the workbook. Here's the code

Option Explicit

Public DepShps() As String
Public ShpCnt As Long
Public StShape As Shape

Sub FindShpDep()

Dim i As Long
Dim lPath As Long
Dim Msg As String

lPath = 1
ReDim DepShps(1 To 2, 1 To 1)
ShpCnt = 0

On Error Resume Next

Set StShape = Selection.Parent.Shapes(Selection.Name)

If Err.Number <> 0 Then
Msg = "No shape selected"
Else
On Error GoTo 0
FindConns StShape, StShape.Parent, lPath

If Len(DepShps(2, 1)) = 0 Then
Msg = "Selected shape has no connectors"
Else
lPath = 1
Msg = "There are " & DepShps(2, UBound(DepShps, 2))
Msg = Msg & " paths to " & StShape.TextFrame _
.Characters.Text & vbCrLf & vbCrLf

For i = LBound(DepShps, 2) To UBound(DepShps, 2)

If DepShps(2, i) <> lPath Then
Msg = Left(Msg, Len(Msg) - 5) & vbCrLf
lPath = DepShps(2, i)
End If

Msg = Msg & StShape.Parent.Shapes(DepShps(1, i)) _
.TextFrame.Characters.Text & " --> "

Next i

Msg = Left(Msg, Len(Msg) - 5)
End If

End If

MsgBox Msg

End Sub

Sub FindConns(StShp As Shape, sht As Worksheet, CurrPath As Long)

Dim shp As Shape

For Each shp In sht.Shapes
If shp.Connector Then
If shp.ConnectorFormat.EndConnected Then
If shp.ConnectorFormat.EndConnectedShape.Name _
= StShp.Name Then

FindDeps shp, shp.Parent, CurrPath
End If
End If
End If
Next shp

End Sub
Sub FindDeps(ConShp As Shape, sht As Worksheet, CurrPath As Long)

Dim shp As Shape

For Each shp In sht.Shapes
If shp.Name = _
ConShp.ConnectorFormat.BeginConnectedShape.Name Then

ShpCnt = ShpCnt + 1
ReDim Preserve DepShps(1 To 2, 1 To ShpCnt)
DepShps(1, ShpCnt) = shp.Name
DepShps(2, ShpCnt) = CurrPath

FindConns shp, shp.Parent, CurrPath
End If
Next shp

If ConShp.ConnectorFormat.EndConnectedShape.Name = StShape.Name Then
CurrPath = CurrPath + 1
End If

End Sub
 
Assuming that you have used the connector shapes to join your objects, you can identify them and discover which shapes are connected
to which other shapes with code like the following:

Sub Test()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
If shp.Connector Then
Debug.Print shp.ConnectorFormat.BeginConnectedShape.Name & _
" connected to " & _
shp.ConnectorFormat.EndConnectedShape.Name
End If
Next shp
End Sub

This might get you started,
 
Back
Top