how to tell if a layer doesn't contain any shapes?

Started by miless2111s, June 08, 2022, 02:19:10 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

miless2111s

I have some code which re-orders layers and it works fine (if a tiny bit slowly) however it will crash and burn if a layer doesn't contain anything. 

How do I check if each layer contains a shape and if not skip over that layer to avoid the crash?
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", "Dependencies", "Overlays", "floating minor time scales", "main_bars", "Progress bars", "RAG bar", "Baseline", "Baseline Link lines", "Minor division labels", "Minor divisions", "Major Divisions", "Time Curtains", "timescale - year lines", "Timescale - minor ticks", "Timescale - bars", "background")
   
    For Each Layer In Layers
   
            Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, CStr(Layer))
            ActiveWindow.Selection = vsoSelection1
            ActiveWindow.Selection.SendToBack
            Debug.Print Layer
    Next Layer
     

Finalise:
    ActiveWindow.DeselectAll

    're-set screen updating etc
    Application.ScreenUpdating = True
    Application.DeferRecalc = False


End Sub

Many thanks

Miles

Paul Herber

The quick and dirty way is to use an
On Error Goto
before the offending code.
As this is VBA, quick and dirty is often the only way.
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

miless2111s

I have it set to goto finalise: which works well so that it doesn't leave Visio in a bad place but it does jump out of the sub when it hits the "comments" layer that doesn't have any shapes on the layer.  This means that the maco as a whole fails to do what it is meant to.

Paul Herber

Well, you want another one

For Each Layer In Layers
            On Error Goto NoShapes
            Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, CStr(Layer))
            ActiveWindow.Selection = vsoSelection1
            ActiveWindow.Selection.SendToBack
            Debug.Print Layer
NoShapes:
Next Layer
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

miless2111s

Quote from: Paul Herber on June 08, 2022, 03:24:06 PM
Well, you want another one

For Each Layer In Layers
            On Error Goto NoShapes
            Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, CStr(Layer))
            ActiveWindow.Selection = vsoSelection1
            ActiveWindow.Selection.SendToBack
            Debug.Print Layer
NoShapes:
Next Layer

I hadn't realised you could use goto in that way, thanks :)  Every day is a learning day :)  Does the 2nd GoTo replace the first - i.e. if errors happen after the loop is finished running does the new error drop you back into to loop (NoShape) or does it revert back to the original (Finalise)?

Paul Herber

Once you fall out of the loop you are at the label Finalise anyway so it makes no difference.
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

miless2111s

Quote from: Paul Herber on June 08, 2022, 03:51:46 PM
Once you fall out of the loop you are at the label Finalise anyway so it makes no difference.
You are absolutely right in this specific case, I was more asking for my continued learning so that I didn't use the same technique at another time and end up in a bad place :)

wapperdude

It's a matter of knowing what the code is doing / supposed to be doing.  Then if there's an error what you want the code to do.

To help understand the code, you can use <f8> key to step thru the code, one line at a time.  Hover the mouse over parameters to see what their value is, and/or dd debug.print statements to check code progress.  You may have drawing and or shape sheet windows open to watch impact of code.  One caution, make sure the drawing window is active before switching back to VBA window & stepping thru code.

This allows you to "see" what the code actually does compared to what you think/wanted it to do.
Visio 2019 Pro

miless2111s

Quote from: wapperdude on June 08, 2022, 08:13:47 PM
It's a matter of knowing what the code is doing / supposed to be doing.  Then if there's an error what you want the code to do.

To help understand the code, you can use <f8> key to step thru the code, one line at a time.  Hover the mouse over parameters to see what their value is, and/or dd debug.print statements to check code progress.  You may have drawing and or shape sheet windows open to watch impact of code.  One caution, make sure the drawing window is active before switching back to VBA window & stepping thru code.

This allows you to "see" what the code actually does compared to what you think/wanted it to do.
in this case it fails during the transition between the following lines.
            ActiveWindow.Selection = vsoSelection1
            ActiveWindow.Selection.SendToBack
This is because there is no shape assigned to the "comments" layer.  Thus I need to understand how to check that the layer "thing" (I don't want to use the word property as that has a meaning in coding).  Using the water window shows that "vsoSelection1 " has one heck of a lot of sub headings or properties and I wondered if one of these might be helpful however I don't know what to use or how to address it :)
The solution from Paul Herber works however (for future code) I wonder if I need to re-assert the on error goto finalise after the loop.

wapperdude

#9
Generated a simple example.  If you open both the drawing window and the VBA window, arrange them side by side, you can witness what the code does.

Notes about the code...
1) uses simple "IF" statement to handle the error situation of no shapes on a layer.
2) the "selection" will include every shape on the chosen layer of interrest.
3) in the macro, the layer names are "hard-coded"

Below is the macro.  Attached is the test file to explore as desired and try out using <F8> in the code window to step thru one line at a time.  Note, you must do single mouse click anywhere within the macro to "identify it" for the <F8> key presses.


Sub SelectShpByLayerName()
'Finds shapes that belong to a specific named layer
'If no shapes belong to chosen layer, then exits without error
'Shapes belonging to chosen layer will have their line properties modified.
'Shapes not belonging to chosen layer are ignored.

    Dim vsoSelection1 As Visio.Selection
    Dim shp As Visio.Shape
   
'    Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, "Connector")
    Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, "Line")
'    Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, "Circle")
'    Set vsoSelection1 = ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, "Rectangle")
    ActiveWindow.Selection = vsoSelection1
    Debug.Print ActiveWindow.Selection.Count    'The selection is the collection of all shapes belonging to specified layer.
   
    If ActiveWindow.Selection.Count > 0 Then    'Indicates how many shapes belong to selection.  Must be at least 1.
        ActiveWindow.Selection.BringToFront     'Brings all shapes to front
            For Each shp In vsoSelection1       'Modifies each shape
                Debug.Print shp.Name
                shp.CellsU("LineColor").FormulaU = "RGB(0,0,255)"
                shp.CellsU("LineWeight").FormulaU = "3 pt"
            Next
    End If
End Sub

Visio 2019 Pro

miless2111s

Thank you wapperdude, I thought there should be a way to check :)

My code now runs fine, it just takes 30 seconds or so but it is a lot faster than doing it by hand!