Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Flowchart Shapes - Follow Path thru Flow Chart

148 views
Skip to first unread message

Steve

unread,
Nov 18, 2002, 3:39:55 PM11/18/02
to
Hi

I would like to be able to trace the flow of a path thru a flow chart

i.e.

shape a -----> shape b ----->shape c
|
|
-------> shape d


If I click on c and activate a macro that can determine the path to c
was from a to b to c and maybe gather the
info stored with shape a and shape b

Is this possible???

Thanks
Steve


Dick Kusleika

unread,
Nov 19, 2002, 9:23:38 AM11/19/02
to
Steve

This should get you started. It assumes you use connector shapes to connect
your flowcharting shapes. It uses recursion to back through the path of the
flow chart and stores each shape name in an array along with its path. Then
it shows a message box showing all the paths. Give it a try and let me know
how it works for you.

To use, select a shape and run FindShpDep.

Here's the code that goes in a standard module:

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.Name & 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 & DepShps(1, i) & " --> "

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

--
Dick Kusleika
MVP - Excel

Post all replies to the newsgroup.

"Steve" <northhaven...@yahoo.com> wrote in message
news:3DD9501B...@yahoo.com...

Steve

unread,
Nov 19, 2002, 6:15:48 PM11/19/02
to
Hi Dick

Thanks very much that did the trick.

Can I ask you one quick question???

Are there certain shapes that don't work ?? i.e the square autoshape15
is not recognized as a shape in this code???

Thanks for all your help
Steve

Dick Kusleika

unread,
Nov 20, 2002, 9:00:25 AM11/20/02
to
Steve

All shapes should work. On which menu is the square shape and when you
hover over it what name does it give. If I can find it, I'll test it out.
The closest I could find was 'Rectangle' on the 'Basic Shapes' menu.

--
Dick Kusleika
MVP - Excel

Post all replies to the newsgroup.

"Steve" <northhaven...@yahoo.com> wrote in message

news:3DDAC624...@yahoo.com...

Steve

unread,
Nov 21, 2002, 8:51:18 AM11/21/02
to
Hi Dick

I was using the Flowchart Shapes

Steve

Dick Kusleika

unread,
Nov 21, 2002, 9:15:19 AM11/21/02
to
Steve

I just tried all the flowchart shapes and they all worked. Are you getting
the "no shape selected" message box or some other error?

You can send me the workbook privately if you like and I will look at it.

--
Dick Kusleika
MVP - Excel

Post all replies to the newsgroup.

"Steve" <northhaven...@yahoo.com> wrote in message

news:3DDCE4D6...@yahoo.com...

Steve

unread,
Nov 23, 2002, 11:06:32 AM11/23/02
to
Hi Dick

I Got it to work - I believe the connectors weren't attached to the shape
completely

Thanks for all your help

Steve

Dick Kusleika

unread,
Nov 23, 2002, 11:29:28 AM11/23/02
to
Steve

Good to hear. You're welcome.

--
Dick Kusleika
MVP - Excel

Post all replies to the newsgroup.

"Steve" <northhaven...@yahoo.com> wrote in message

news:3DDFA788...@yahoo.com...

0 new messages