Dynamic macro to show and hide layers.

[pandadude]

Lets say I have diagram with 10 objects and 10 layers; a layer for each object. (but the layer names do not match the names of its corresponding shapes)


I'm interested in a macro that is able to hide all other layers and only show specific layer when I double click a shape (by changing the double-click behavior of the shape to run a macro) without recording 10 different macros and then assigning them one by one to its corresponding shape.


Thanks


EDIT:
I've put some thought into it, and I believe that I can make it work if I changed the name of the layer to the name of its shape, and then run the macro by selecting it and then activating it through the shortcut (ctrl + key), then the code's flow would look something like this:

Run a macro that hides everything (Can be done easily by recording a macro)

(then, adding the following code logic below)

If "name_of_selected_shape" == "name_of_layer"
      then visLayeVisible = "1"

End Sub

Another way to do it would be:

If "name_of_selected_shape" == "name_of_layer"
      then visLayerVisible = "1"
      else visLayerVisible = "0"

End Sub

I Just don't know how to word/implement it. I do know that you'd have to play around with this one though.
vsoLayer1.CellsC(visLayerVisible).FormulaU = "1"

[wapperdude]

Here's piece of code that finds the shape's layer assignment (assumes only one layer per shape), then goes thru and hides all the other layers.  From this, you ought to be able to expand to unhide the layers...

Code Select Expand

Sub ShapeLayerName()
    Dim vsoLayer As Visio.Layer
    Dim vsoLayerN As Visio.Layer
    Dim vsoShape As Visio.Shape
   
    Set vsoShape = ActiveWindow.Selection(1)               'select shape to keep visible
    Set vsoLayerN = vsoShape.Layer(1)                       'get layer name of shape
    For Each vsoLayer In ActiveWindow.Page.Layers           'iterate thru layers and hide
        If vsoLayer <> vsoLayerN Then
            vsoLayer.CellsC(visLayerVisible).FormulaU = "0"
        End If
    Next
End Sub

HTH
Wapperdude

[wapperdude]

For those who might be interested, attached Visio file is one approach to toggling the shape visibility using layers.

It leverages a pre-existing file which was setup to use the actions context menu of the page to control the layers.  Now, there's both.

For those who just want the code:

Code Select Expand

Sub ShapeLayerName()
'wapperdude, 2/12/2015
'minimal error checking
'
    Dim vsoLayer As Visio.Layer
    Dim vsoLayerN As Visio.Layer
    Dim vsoShape As Visio.Shape
   
    If Visio.ActiveWindow.Selection.Count = 0 Then              'This check needed if sub is run manually.
        MsgBox "Select a shape first, and re-run macro."
    Else
        Set vsoShape = ActiveWindow.Selection(1)                'select shape to keep visible
        If vsoShape.LayerCount = 0 Then                         'If no layer assigned to shape, exit sub.
            MsgBox ("No layer assigned. Assign layer to shape and retry.")
        Else
            Set vsoLayerN = vsoShape.Layer(1)                   'get layer name of shape
            For Each vsoLayer In ActiveWindow.Page.Layers       'iterate thru layers and toggle layer visibility
                If vsoLayer <> vsoLayerN Then
                    If vsoLayer.CellsC(visLayerVisible).ResultStr(Visio.visNone) = "1" Then
                        vsoLayer.CellsC(visLayerVisible).FormulaU = "0"
                    Else
                        vsoLayer.CellsC(visLayerVisible).FormulaU = "1"
                    End If
                End If
            Next
        End If      'End check if shape has layer assigned, proceed to exit.
    End If          'End check for shape selection if run manually
End Sub

Enjoy.
Wapperdude

[shockeymoe]

I just posted a similar question although mine is using layers to achieve the effect you are after.
Check it out here: http://visguy.com/vgforum/index.php?topic=6302.0

[pandadude]

Thanks Wapperdude (No 'h' this time).

I can't use your code because I think your macro only works for a layer with one shape in it. I have multiple layers containing multiple shapes, and the only way for this to work is if I can cross check the name of the shape with the name of the layers that I have.

How I'm going about is: I'm first going to hide all the shapes by iterating through all the layers and hiding everything, then for each of the shapes I have selected, I will take the name of the shape and then iterate it through each of the layers and then make the layer visible if the names match; i.e. the name of the shape matches the name of the layer.

This is my code so far (Sadly does not work as I do not know how to pull the name of the shapes and layers. I hope the logic is understandable enough, though.)

Code Select Expand

Sub ShowProcessFlow()
'wapperdude, 2/12/2015
    Dim vsoLayer As Visio.Layer
    Dim vsoLayerN As Visio.Layer
    Dim vsoShape As Visio.Shape
    Dim vsoSelection As Visio.Selection
                       
    If Visio.ActiveWindow.Selection.Count = 0 Then              'This makes sure somehting is selected
        MsgBox "Select a shape or multiple shapes first, then re-run macro."
    Else
       
    For Each vsoLayer In ActiveWindow.Page.Layers           'Hides all layers
       
            vsoLayer.CellsC(visLayerVisible).FormulaU = "0"
     
    Next
   
    For Each vsoSelection In ActiveWindow.Page.Layers      'runs through each selection; runs through 3 times if there are 3 shapes selected)
   
    Set vsoSelection = ActiveWindow.Selection(i)            'Not sure if this thing is doing what I want it to do (this line and the next line)
   
    Set vsoShape = vsoSelection                              'Essentially trying to set the active selection to equal a shape and then seeing if the shape name equals that of any layer name.
           
            If vsoSelection = vsoLayer Then             'If name of shape = name of layer, make that layer visible
           
            vsoLayer.CellsC(visLayerVisible).FormulaU = "1"
           
            End                  'Ends If loop if it has come across a name
            Else                  'Else keep on running
       
        Next
   
    Next

End Sub


What can I do to solve this? (Please be gentle with me, first time coding with VBA, any advice would be much appreciated)


Also, how do I easily set the actions in shapestreet to show all layers? From what I understand I have to type this formula if I have 3 layers:

Code Select Expand


=SETF(GetRef(Actions.LyrA.Checked),FALSE)+SETF(GetRef(Actions.LyrB.Checked),FALSE)+SETF(GetRef(Actions.LyrC.Checked),FALSE)+SETF(GetRef(Actions.LyrAll.Checked),TRUE)+SETF(GetRef(Layers.Visible),TRUE)+SETF(GetRef(Layers.Visible[2]),TRUE)+SETF(GetRef(Layers.Visible[3]),TRUE)

So if I have 70 layers do I have to type it out 140 times or is there an easier way? Thanks so much.

EDIT:

I was thinking that of using" vsoShape.Name", but I think that uses the preset "name", for example Connector 178 for a selected connector or Shape 87 for a selected shape. What I think I would need would be the string name, so maybe "vsoShape.String"?

[wapperdude]

Some thoughts:
  1.  the setf(...) + setf(...) + .... formulas are only needed if you plan to use the page right click menu option.  Not needed if you plan to use macro only.
  2.  You could use a dynamic array, where the number of elements = number of layers in selected shape.
          a.) You would loop thru the shape, I=1 to N, N is the number of layers, and set the value for each layer, e.g., Set vsoLayerN(i) = vsoShape.Layer(i)
          b.) Then, hide all the layers, followed by unhiding each layer in the array.

Think that's all you need to do.

Should work I think.

Wapperdude

[pandadude]

Hello friends.


This is what I ended up using (After modifying Wapperdude's code above):

Code Select Expand

Sub SingularShowProcessFlow()
'wapperdude, 2/12/2015
'Panda, 25/2/2015
'minimal error checking
    Dim vsoLayer As Visio.Layer
    Dim vsoLayerN As Visio.Layer
    Dim vsoShape As Visio.Shape
   
        If Visio.ActiveWindow.Selection.Count = 0 Then              'This check needed if sub is run manually.
            MsgBox "Select a shape first, and re-run macro."
        Else
            Set vsoShape = ActiveWindow.Selection(1)                'select shape to keep visible
            If vsoShape.LayerCount = 0 Then                         'If no layer assigned to shape, exit sub.
                MsgBox ("No layer assigned. Assign layer to shape and retry.")
            Else
                'Set vsoLayerN = vsoShape.Layer(1)                   'get layer name of shape
                For Each vsoLayer In ActiveWindow.Page.Layers       'iterate thru layers and toggle layer visibility
                    If vsoLayer.Name <> vsoShape.Text Then
                        If vsoLayer.CellsC(visLayerVisible).ResultStr(Visio.visNone) = "1" Then
                            vsoLayer.CellsC(visLayerVisible).FormulaU = "0"   'turns every layer that's visible to be not visible and vice versa
                        Else
                            vsoLayer.CellsC(visLayerVisible).FormulaU = "1"
                        End If
                    End If
                Next
            End If      'End check if shape has layer assigned, proceed to exit.
        End If          'End check for shape selection if run manually

    Call zoomOnSelection
   
End Sub

This code takes the shape you have selected and matches its text with the names of every layer you have. If the text of the shape equals the name of the layer, the macro turns that layer visible and every other layer invisible. Activating the code again on the same shape turns on every layer. You can also assign this macro to run whenever the shape is double clicked and it will work perfectly as well(Which is what I'm doing)

The reason why I named it "singular" is because this code works beautifully for showing only one shape's layer. I tried to create another macro that takes EVERY selected shape and turns those layers on and then turn the others off (basically does the same thing as this to multiple shapes. The reason why you can't use this macro to do that is that it turns every other layer other than itself off and you can only do that once; the second time you run it, it will over-ride the first one and turn that layer off). I was close to completing it, but had a bunch of bugs, ran out of time,  and you'd have to teach everyone that uses this file to "select the selected shapes and run the macro", then "running another macro to show all of them again" (the converse is using the shapestreet function, but as I have over 70 layers, this is kind of a bother to do), so I decided to just scrap it. (if anyone wants to see this code I wouldn't mind posting it up, but it's got a bug somewhere)

The function "zoomOnSelection" basically helps "refresh" the page. I get a visual bug when I run the macro (the shapes and connectors aren't there anymore but I can still see them) as I have a lot of shapes and connectors on my page. I would have to manually zoom in and out to "refresh" the page and show the product of the code. I then found Yaccine's macro after searching for awhile to do this automatically for me:

Code Select Expand


Sub zoomOnSelection()
    Dim t As Double, b As Double, l As Double, r As Double
    Dim zoomFaktor As Double
   
    ThisDocument.ZoomBehavior = visZoomVisioExact 'You'd place this statement in a more central place for elegance sake

    ActiveWindow.Selection.BoundingBox visBBoxUprightWH, l, b, r, t
        zoomFaktor = 1 ' to get bigger boundaries around the selection
        l = 1 / zoomFaktor ' You might also use addition and substraction, if page size matters (which I suspect).
        b = b / zoomFaktor
        r = r * zoomFaktor
        t = t * zoomFaktor
    ActiveWindow.SetViewRect l, t, (r - l), (t - b)
End Sub


Thanks again to Wapperdude for the help! Much appreciated.

PandaDuDe

[wapperdude]

From what you said can't tell if the need went away or you have up because of bugs.  The multiple selection is doable.  The approach I would take is similar to the single selection technique except for:
  1. Iterate thru all of the selections and store those shapes in a dynamic array.
  2. Hide all the layers
  3. Iterate thru this shape array and turn on the layers associated with each shape.
  4. Rerun macro a 2nd time to restore all layers or have a dedicated macro for all layers on.

Note, double click won't work in this case as it deselects all other shapes.

Wapperdude

[wapperdude]

Re-worked the macro.  It now accepts single or multiple selections. Rerun macro with no selections and makes all layers visible.  Virtually no learning curve.

Will upload if there's interest.

Wapperdude

[lovko]

Re-worked the macro.  It now accepts single or multiple selections. Rerun macro with no selections and makes all layers visible.  Virtually no learning curve.

Will upload if there's interest.

Wapperdude

Yes, I'd be grateful.
Thank you

[wapperdude]

Here's the updated file.

[OldSchool1948]

Here's another approach:

Code Select Expand

Private Sub test()

    '// strLayerState "0" = hide
    '// strLayerState "1" = show
    Dim strLayerState As String
    strLayerState = "1"
   
    Dim strThisLayer As String
    strThisLayer = "base_layer"  '// Set this to whatever/however you need
   
    Call showHidePageLayer( _
            strThisLayer, _
            strLayerState)

End Sub

Code Select Expand

Private Sub showHidePageLayer( _
        strThisLayer As String, _
        strLayerState As String)

    Dim vsoPage As Visio.Page
    Dim vsoLayer As Visio.Layer

    For Each vsoPage In ActiveDocument.Pages
   
        '// Make sure layer exists on this page
        If isLayer(strThisLayer, vsoPage) = True Then
       
            '// strLayerState "0" = hide
            '// strLayerState "1" = show
            Set vsoLayer = vsoPage.Layers(strThisLayer)
            vsoLayer.CellsC(visLayerVisible).FormulaU = strLayerState
            vsoLayer.CellsC(visLayerPrint).formula = strLayerState
                         
        End If

    Next vsoPage

End Sub

Code Select Expand

Private Function isLayer( _
        strThisLayer As String, _
        vsoPage As Visio.Page) As Boolean

    Dim vsoLayer As Visio.Layer
    On Error Resume Next
    Set vsoLayer = vsoPage.Layers(strThisLayer)
    On Error GoTo 0
   
    isLayer = IIf(vsoLayer Is Nothing, False, True)
   
End Function