VISIO CHALLENGE: Design Recursive Algorithm

[wapperdude]

Hello Visio Fans!

Welcome to the first Visio challenge.  The goal:  develop a recursive algorithm to search thru ALL shapes on a page, and list them.  Debug.print is fine.  The code must search the entire page and find all shapes, even though they may be part of a group, or even a nested group.  The program must be well-behaved.  Obviously, endless looping is not well behaved.  Nor is loop aborting due to error.  It should also be compatible with V2007 and older.

Let's see how creative you can be.

I've attached a file that has a bunch of shapes, grouped and otherwise.  It would make a good common basis for code development.

Yes.  I do have a solution.  But, being a non-programmer, it may lack a certain amount of refinement.  Does seem to be well-behaved, though.

Have fun!
Wapperdude

[Surrogate]

I just modify code from post 

Code

Sub Main()
   ShapesList ActivePage.Shapes
End Sub

Sub ShapesList(ByVal shps As Shapes)
   Dim sh As Shape
   For Each sh In shps
       If sh.Shapes.Count <> 0 Then ShapesList sh.Shapes
       Debug.Print sh.ID, sh.Name
   Next sh
End Sub

[Yacine]

We had this question here:
http://visguy.com/vgforum/index.php?topic=5802.0;nowap

[wapperdude]

@ Yacine:  Well, I did forget about that topic.  I will look at  again, and Surrogate's response.  But, technically, your code doesn't do the listing.  😵  ...  😇

Hey!  It's my post, I can make the rules as I want.  😱  😕  😠  😉  Just call me .... uh ... Mr. Grumpy.  Ha!

LOL

Grumpy (aka Wapperdude)

[Yacine]

As you wish, Master of the Post.

[wapperdude]

As promised, I looked at both responses.  Both did the job of finding shapes.  The Surrogate code provides a slightly more complete listing as it finds all shapes.  To be fair, Yacine code was quasi-pseudocode, and as such, may have some limitations as a result of my editing. I know, Bad dog.  Bad dog.  No dog yummies for me!

If so, my apologies, Yacine.

While both work well, my unstated intention, was to exclude "group" shapes, as, while they do have shape ID's, e.g., sheet.979, technically, they aren't shapes, but rather a collection of shapes.  So, I am including an updated file, which has both codes included.  If either Surrogate, or Yacine, or anyone else, would like to update, contribute to this post with code that excludes the group shapes, that would still be of interest.  If not, I will update the post a little later, with code I developed that does exclude the groups.

Note, there are no prizes.  Simple searching thru shapes doesn't find all shapes, and requires a recursive algorithm to push down into the groups.  Such code is not easily found on this forum or via web searching.  So, this post was really about readily finding such code.

Thanks to both Surrogate and Yacine.

Wapperdude

[Yacine]

NO PRIZES!?! 

[wapperdude]

Yeah.  I thought about a Ferrari, but, decided that would be inappropriate.  Not keeping with the Green Earth ideals.   

[wapperdude]

Well, I decided to try some simple changes to both sets of code.  Result, both list only the "actual" shapes, ignore the "group shapes".

Change was simple.  I like both solutions better than my own, so, here is updated file with updated code.  My code not included.

Since, I modified the code, and both give the same results, I declare this contest over, a tie, with an assist from me.  Should a prize become available, it will be donated to yet unspecified worthy cause!   

wapperdude

Surrogate based code:

Code

Sub Main()
' Code provided by Surrogate
    ShapesList ActivePage.Shapes
End Sub

Sub ShapesList(ByVal shps As Shapes)
    Dim sh As Shape
    For Each sh In shps
        If sh.Shapes.Count = 0 Then
            Debug.Print sh.ID, sh.Name
        End If
        ShapesList sh.Shapes
    Next sh
End Sub

Yacine based code:  (could be cleaner by tiding up some of my edits)

Code

Sub MainLoop()
' Code created by Yacine, updated by Wapperdude
    Dim shp As Visio.Shape
    
    For Each shp In ActivePage.Shapes 'note the difference to activewindow
        If shp.Shapes.Count = 0 Then
            Debug.Print shp.Name
        End If
        
        actualProcessingAndDeeperLoop shp
    Next shp
End Sub

Sub actualProcessingAndDeeperLoop(shp As Visio.Shape) 'this one is recursive
    Dim subShp As Visio.Shape
    Dim subShps As Visio.Shapes
    Set subShps = shp.Shapes
    For Each subShp In subShps
        If subShp.Shapes.Count = 0 Then
            Debug.Print subShp.Name
        End If
        actualProcessingAndDeeperLoop subShp
    Next subShp
End Sub

[Yacine]

Surrogate's is shorter as it passes a "shapes" instead of a "shape" object.
He deserves the Ferrari. May be he can give me a ride.

[wapperdude]

This was interesting for me.. better understanding of recursive loops, calling subs, and passing arguments.

Wapperdude

[Surrogate]

No, it is not mine code.
Scooter is not mine, I just posted an ANNOUNCEMENT!

That code posted in russian visio forum by user 9rey. I find that code there

UPDATE: i shared that code early

Thanks to 9rey for recursion macro

[wapperdude]

Guess I'm off the hook for  Ferrari.  ...  That's!  😁

Wapperdude