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.
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
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
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 (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
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/ (http://www.visguy.com/2006/11/20/legend-shapes/)
wapperdude
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.
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
Thank you again for all your help with this much appreciated.
Greg
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