Select all shapes on a layer and send to the back

[miless2111s]

I want to be able to select all objects which are members of a layer and send them all to the back at the same time.   Recording the macro gives this:

Code Select Expand

Sub test_select_layers()

    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150

    Dim vsoSelection1 As Visio.Selection
    Set vsoSelection1 = Application.ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, "Rectangles")
    Application.ActiveWindow.Selection = vsoSelection1

    ActiveWindow.DeselectAll
    ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1), visSelect
    ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(2), visSelect
    ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(3), visSelect
    Application.ActiveWindow.Selection.BringToFront

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

This  gives rise to the following issues:
1) Generally using "select" type operations in VBA makes the code run more slowly (I don't know if this is the case with Visio but it is with Excel)
2) The select ID1,2 and 3 implies that I need to know everything that is on the layer which I will now.

Googling around the place gives some hope in the form of this thread: http://visguy.com/vgforum/index.php?topic=3488.0 however I struggle to see how to use this to select rather than debug.print.  Better yet I would like to be able to just send all the shapes identified to the back in one set.

Ideally, I would like to be able to loop through a set of layer names held in an array or some other listing to control the order that the shapes on the layers are selected, send each to the back and then move onto the next layer in the list....

Can anyone help?   Thanks

[Paul Herber]

Just wondering why you are selecting shapes by a layer, then deselecting everything, then selecting three shapes, then performing an operation on that selection!

[wapperdude]

@Paul Herber:  The selecting / deselecting / reselecting does seem curious.  Since I like cats, needed to look at this.  Did a quick test, 4 shapes, 1 pair set to "Layer1" and 2nd pair set to "Layer2".
Used the Macro Recorder, did a select by layer, choosing Layer1, then sent the selection to bhe back.  Stopped the recorder.  It does exactly this process.  Struck me as unnecessary to do the Delect / Reselect, and commented out those lines.  Works fine.  Mystery solved.  Cats are alive.  Here's cleaned up  code snippet from macro reeccorder:

Code Select Expand


Sub Macro1()

    Dim vsoSelection1 As Visio.Selection
   
    Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, "Layer1")
    ActiveWindow.Selection = vsoSelection1

'    ActiveWindow.DeselectAll
'    ActiveWindow.Select ActiveWindow.Page.Shapes.ItemFromID(3), visSelect
'    ActiveWindow.Select ActiveWindow.Page.Shapes.ItemFromID(1), visSelect

    ActiveWindow.Selection.SendToBack

End Sub


[miless2111s]

thank you for checking, I will try this out later today. 

How can I loop through a list of layers?  Can I use an array as I would in Excel and if so how does this work in Visio?

Many thanks

Miles

[wapperdude]

Layers are a page property, not a document property.  So, you would have to look thru each page, and then for each page loop thru each layers collection. 

See https://docs.microsoft.com/en-us/office/vba/api/visio.page.layers

[Paul Herber]

But you can't access the shapes via the layer. Shapes do not belong to a layer, layer(s) are a property of the page that can be assigned to a shape (or part of). Different parts of grouped shapes can be on different layers.

[wapperdude]

Correct.  Wasn't implying accessing shapes, just how to iterate thru layers on a page.  Hide the layer = hide the member shapes.

[miless2111s]

I know what the layers are called (in fact any that I don't know about shouldn't be touched), so I was wondering if there was the ability to do something like:

Sub LoopThroughlayers()

    Dim Layers As Variant
    Dim Layer As Variant
    Dim vsoSelection1 As Visio.Selection

    Layers = Array("Top", "Middle", "Bottom")

    For Each Layer In Layers
            Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, Layer)
            ActiveWindow.Selection = vsoSelection1
            ActiveWindow.Selection.SendToBack
    Next Layer

End Sub

Obviously, this doesn't work but I hope it suggests where my thought process was going and can help point out the mistake I am making

[Yacine]

Your code actually works, you just need to convert the "Layer" argument into a string - I don't know why!
Write CStr(Layer) instead of Layer.

[miless2111s]

Your code actually works, you just need to convert the "Layer" argument into a string - I don't know why!
Write CStr(Layer) instead of Layer.

Excellent, thanks   So close

[miless2111s]

My final code is:

Code Select Expand

Sub ReOrder_Layers()

    Dim Layers As Variant
    Dim Layer As Variant
    Dim vsoSelection1 As Visio.Selection
    On Error GoTo Finalise
       
    Application.ScreenUpdating = False
    Application.DeferRecalc = True
    ActiveWindow.DeselectAll

    Layers = Array("Comments", "......12 other layers.... "background")
   
    For Each Layer In Layers
   
            Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, CStr(Layer))
            ActiveWindow.Selection = vsoSelection1
            ActiveWindow.Selection.SendToBack
           
    Next Layer
     

Finalise:
    ActiveWindow.DeselectAll

    're-set screen updating etc
    Application.ScreenUpdating = True
    Application.DeferRecalc = False
    MsgBox ("all done")

End Sub

This performs the action on 14 layers in around 40 seconds.  Can anyone think of any way to speed this up?