Display layer names of which a shape is a member in custom properties

[joegarber]

Hi, I'm trying to write a short vba to print/echo all layers of which a
shape is a member to a field in its custom properties. This seems
simple enough but I am brand new to VBA and nearly so to Visio. Can
someone help me with this? Thanks very much.

Joe

 

[JuneTheSecond]

Visio VBA Information,
http://www.mvps.org/visio/VBA.htm
has examples about Layers.

 

[joegarber]

I had been to that site and tried to modify one of the layer examples
for what I need. But since this is my first time writing/modifying VBA
code, instead of just using someone else's, I wasn't sure about some of
the terms and logic and didn't get anywhere with it. I was hoping you
or someone might have a moment to modify one of those examples for what
I need.

I can see that this would be a cinch were it in a language I was
familiar with, so I know it sounds like a noob request. Thanks

 

[Al Edlund]

try something like this
al


'
' put the names of a layers into a custom property
' named layerlist
'
Public Sub SaveLayers

Dim visPage As Visio.Page
Dim visShapes As Visio.Shapes
Dim visShape As Visio.Shape
Dim visLayers As Visio.Layers
Dim visLayer As Visio.Layer
Dim visCell As Visio.Cell
Dim intI As Integer
Dim intLayerCt As Integer
Dim strOut As String

Set visPage = Application.ActivePage
Set visShapes = visPage.Shapes

For Each visShape In visShapes
strOut = ""
intLayerCt = visShape.LayerCount
For intI = 1 To intLayerCt
Set visLayer = visShape.Layer(intI)
If intI <> visShape.LayerCount Then
strOut = strOut & visLayer.Name & ", "
Else
strOut = strOut & visLayer.Name
End If
Next intI
If visShape.CellExists("Prop.LayerList", False) Then
Set visCell = visShape.Cells("prop.layerlist")
visCell.Formula = StringToFormulaForString(strOut)
End If
Next

End Sub


'
' this from the visio 2003 sdk
'
Public Function StringToFormulaForString(strIn As String) As String

Dim strResult As String
On Error GoTo StringToFormulaForString_Err

strResult = strIn

' Replace all (") with ("").
strResult = Replace(strResult, Chr(34), _
Chr(34) & Chr(34))

' Add ("") around the whole string.
strResult = Chr(34) & strResult & Chr(34)

StringToFormulaForString = strResult

Exit Function

StringToFormulaForString_Err:
Debug.Print Err.Description

End Function

 

[joegarber]

Thanks Al! That worked perfectly. I did another search and found how to
call your SaveLayers method when the document is opened, which, if any
other folks like me are interested, can be done by placing the
following in the ThisDocument object:

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
Module1.SaveLayers
End Sub

Most people who will see this probably know how to do that, but it's
all very new and cool to me.

 

[Al Edlund]

da nada,
have a great one,
al