Adding visLegendShape Section To Multiple Shapes

Started by Gregory Jackson, June 17, 2016, 09:29:21 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Gregory Jackson

I adding the "vislegnedShape" parameter to my shapes via shape sheet. Is there a way to do add a usesrdefined section and then define a row with the visLegendShape parameters. Als can this be  done on multiple shapes at teh same time?

Thanks,

R

I have read some of the other post but they're focused on text not actually adding a user-definedcells section.

Any help is appreciated.

wapperdude

The following code snippet example provides the syntax you need.  The desire is to have a User row named, User.From.  Code checks if it already exists.  If not, adds the row to the User Section.  Following line initializes it to be blank

    If Not shape.CellExistsU("User.From", False) Then
        shape.AddNamedRow visSectionUser, "From", visdefault
    End If
    shape.CellsU("User.From").FormulaU = ""


Modify / expand as desired.

Wapperdude
Visio 2019 Pro

Gregory Jackson

Thanks for quick response greatly appreciated.

getting runtime error '424'

Here is the modified code:

Sub VisLegendShape()
If Not Shape.CellExistsU("User-defined Cells", False) Then <-- failing on this line
        Shape.AddNamedRow visSectionUser, "User-defined Cells", visdefault
    End If
    Shape.CellsU("User.From").FormulaU = ""
    End Sub

Also once the user-defined cell section is added will this macro prompt me to add the "VisLegendShape" attribute on all the shapes on the sheet?

BTW I know enough about VB to dangerous..


Thanks,

R

wapperdude

#3
Ok.  I had impression that you were familiar with VBA.

Few things, 1)  this piece of  code  assumes you've selected a shape, 2) this code is just a snippet, it is not complete.  You need to add dimension statements.  So, something like...


Sub visLgn ()
    Dim shp as Visio.shape

    If Not shp.CellExistsU("User.From", False) Then
        shp.AddNamedRow visSectionUser, "From", visdefault
    End If

    shp.CellsU("User.From").FormulaU = ""

End Sub


Here's a starter place:  https://msdn.microsoft.com/en-us/library/office/ff766902.aspx

To get to the VBA edit window, press <ALT> + F11

Also, download the SDK  kit, it's free.  It has lots of examples.  Plus, the macro recorder is a good way to record some basic steps and see the code for those steps.

Wapperdude
Visio 2019 Pro

wapperdude

#4
Ooops.  Realized I left out a step in the code.  So, here's code that will add the legend call, to a shape.  Note, the legend will not update until the shape is dropped onto the page.  The IsConnected is commented out.  Don't believe it's needed for what you're doing.


Sub AddLgnd()
   
    Dim shp As Visio.Shape
       
    Set shp = ActiveWindow.Selection(1)
    If Not shp.CellExistsU("User.visLegendShape", False) Then
        shp.AddNamedRow visSectionUser, "visLegendShape", visdefault
    End If
    shp.CellsU("User.visLegendShape").FormulaU = "2"
   
'    If Not Shp.CellExistsU("User.visIsConnected", False) Then
'        Shp.AddNamedRow visSectionUser, "visIsConnected", visdefault
'    End If
'    Shp.CellsU("User.visIsConnected").FormulaU = "0"
   
End Sub


You can open the document stencil, double click a shape to update, select the shape, run the macro, and close the window.  It will ask to update all instances, say yes.  Now all instances of that shape will have the visLegend reference. 

You could also write code to loop thru all shapes on all pages and add the code. 

The legend itself will not be updated until either each shape is replaced or the legend itself is replaced.

For more re Legend shape, see Visio Guy's article:  http://www.visguy.com/2006/11/20/legend-shapes/

wapperdude
Visio 2019 Pro

Gregory Jackson

Awesome thank you for your help..

You mentioned "You could also write code to loop thru all shapes on all pages and add the code." I would like to do this how exactly would that look. If you can
t supply the code maybe point in the direction of an example I'd like to learn how to write more scripts  myself.

wapperdude

#6
Below is code for basic looping thru the shapes on a page.  It does not check for grouped shapes.  To search thru pages, you need to check the references I gave earlier.


Sub AddLgnd()

    Dim vsoShps As Visio.Shapes
    Dim vsoShp As Visio.Shape
   
    Set vsoShps = ActiveWindow.Page.Shapes
    For Each vsoShp In vsoShps
        If Not vsoShp.CellExistsU("User.visLegendShape", False) Then
            vsoShp.AddNamedRow visSectionUser, "visLegendShape", visdefault
        End If
        vsoShp.CellsU("User.visLegendShape").FormulaU = "2"
     next   
   
end sub


This ought to get you started. 
Wapperdude

Visio 2019 Pro

Gregory Jackson

Thank you again for all your help with this much appreciated.

Greg

wapperdude

#8
Here's the code.  Select and run the PageSearch module.  Calls to other modules are performed as necessary.  At bottom of PageSearch you can select to do either simple or recursive shape search by commenting out the undesired search algorithm.  Presently, simple search is chosen.

There seems to be a residual LegendShape updating issue.  Just deleting and replacing the LegendShape didn't seem to work.  Rather, had to do a <cntl> + A to select all shapes.  The <cntl> + X to cut them, and <cntl>+V to drop them back on the page.

EDITOR NOTE:  updated the AddLegend module @ 6:11:58PM, June 20, 2016.  The update appears  ??? to correct the Legend updating, such that re-dropping just the Legend is enough to get it to update.  Or, has nothing to do with it, and can be commented out.   ::)   >:(



Sub PageSearch()

    'Declare object variables as Visio object types.
    Dim vsoPage As Visio.Page
    Dim vsoPages As Visio.Pages

    'Iterate through all pages in a drawing.
    Set vsoPages = ActiveDocument.Pages
    For Each vsoPage In vsoPages
        Debug.Print ""
        Debug.Print vsoPage.Name
        Call SimpleSearch(vsoPage)          'Call simple shape search
'        Call RecursiveSearch(vsoPage)          'Call recursive shape search
    Next

End Sub


Sub SimpleSearch(vsoPage As Visio.Page)   'This is non-recursive
    Dim vsoShps As Visio.Shapes
    Dim vsoShp As Visio.Shape
    Set vsoShps = vsoPage.Shapes
    For Each vsoShp In vsoShps
        If vsoShp.Shapes.Count = 0 And Not vsoShp.OneD Then   'exclude 1D objects (lines and connectors)
            Debug.Print vsoShp.Name
            Call AddLgnd(vsoShp)
        End If
     Next

End Sub


Sub RecursiveSearch(vsoPage As Visio.Page)
' Code provided by Surrogate
    ShapesList vsoPage.Shapes
End Sub

Sub ShapesList(ByVal shps As Shapes)
    Dim sh As Shape
    For Each sh In shps     'recursively search all shapes on a page
        'Add Legend reference
        If sh.Shapes.Count = 0 And Not sh.OneD Then   'exclude 1D objects (lines and connectors)
            Debug.Print sh.Name
            Call AddLgnd(sh)
        End If
        ShapesList sh.Shapes
    Next sh
End Sub

Sub AddLgnd(vsoShp As Visio.Shape)

    If Not vsoShp.CellExistsU("User.visLegendShape", False) Then
        vsoShp.AddNamedRow visSectionUser, "visLegendShape", visdefault
    End If
    vsoShp.CellsU("User.visLegendShape").FormulaU = "2"
   

    If Not vsoShp.CellExistsU("User.visIsConnected", False) Then
        vsoShp.AddNamedRow visSectionUser, "visIsConnected", visdefault
    End If
    vsoShp.CellsU("User.visIsConnected").FormulaU = "0"

   
End Sub


Wapperdude
Visio 2019 Pro