I've been playing with this for a while and can't get my head around why it won't work..
Bear in mind I'm fairly novice when it comes to VBA mostly taking code examples and adjusting them for what I want it to do.
I'm trying to highlight incoming and outgoing connectors to a shape but also pull the highlighted connectors from a non-visible layer to a visible one. The code I have at the moment (found in an old thread on this forum I think) looks like this:
selShp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = selClr 'Highlight selected shape
For i = 1 To selShp.FromConnects.Count 'Get the connected "from" shapes, i.e., what is glued to the selected shape.
Set FromConShp = selShp.FromConnects(i).FromSheet 'This is connector glued to the selected shape.
FromConShp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU = """3;6""" 'Copy selected layer 3 connectors to 3 and 6
FromConShp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = HiClr 'Highlight connectors
Application.ActiveWindow.Selection.BringToFront
For Each conObj In FromConShp.Connects 'Find shape connected to opposite connector end
Set ToConShp = conObj.ToSheet 'This is the opposite end shape, that the from shape is attacthed to.
If ToConShp <> selShp Then 'Skip selected shape; already colored.
ToConShp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = DestClr
End If
Next conObj
Next i
The issue I have is that this will select all connectors to the shape (currently on layers 2 and 3) and move them to layers 3 and 6, what I want is to be able to select only the connectors on layer 3 and move them to layers 3 and 6. I've tried using an if statement on these lines but get an invalid property on the FormulaU part of the code.
If FromConShp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU = """3""" Then
Set FromConShp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU = """3;6"""
Is it possible to just select connectors to the shape on a certain layer?
Further complication... Once I've got this sorted I also want to differentiate between the incoming and outgoing connectors. I've tried using GluedShapes (visGluedShapesIncoming1D, " ") instead of the FromConnects but it comes up as an invalid qualifier and I'm not sure why. If I can get these to work correctly I'm confident I can edit enough to have different highlights for incoming and outgoing connectors.
Thanks
Regarding connectivity, incoming/outgoing connections, see: http://visguy.com/vgforum/index.php?topic=8701.msg38015#msg38015 (http://visguy.com/vgforum/index.php?topic=8701.msg38015#msg38015)
For layer membership, you need to add IF condition to the shape to see if the desired layer is layer is visible or not. See reply number 2 of this post to help search for layer by name: http://visguy.com/vgforum/index.php?topic=8635.msg37650#msg37650 (http://visguy.com/vgforum/index.php?topic=8635.msg37650#msg37650)
These ought to help.
Thanks Wapperdude
The layer setting has worked perfectly, I've now got:
If FromConShp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU = """3""" Then
Set vsoLayer1 = ActivePage.Layers.Item("Connector")
vsoLayer1.Add FromConShp, 1
End If
Which does exactly what I want in pulling items only from layer 3 to the connector layer while maintaining membership of layer 3.
Time to get my head around the connectivity now.
Sorted.
It all seems so simple now:
Dim shpIDs() As Long
Dim SelShp As Visio.Shape
shpIDs = SelShp.GluedShapes(visGluedShapesIncoming1D, "") ' Highlight incoming connectors
For i = 0 To UBound(shpIDs)
ActivePage.Shapes.ItemFromID(shpIDs(i)).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = InClr
Next
shpIDs = SelShp.GluedShapes(visGluedShapesOutgoing1D, "") ' Highlight outgoing connectors
For i = 0 To UBound(shpIDs)
ActivePage.Shapes.ItemFromID(shpIDs(i)).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = OutClr
Next
This works for me:
Public Sub setShapeOnLayer( _
vsoPage As Visio.Page, _
vsoshape As Visio.Shape, _
strLayerName As String)
Dim vsoLayer As Visio.Layer
If isLayer( _
strLayerName, _
vsoPage) = False Then
Call vsoPage.Layers.Add(strLayerName)
End If
Set vsoLayer = vsoPage.Layers(strLayerName)
'// Remove from any existing layer
vsoshape.CellsSRC(visSectionObject, visRowLayerMem, _
visLayerMember).FormulaForceU = """"""
'// Add shape to layer
vsoLayer.Add vsoshape, 0
End Sub
Public Function isLayer( _
strThisLayer As String, _
vsoPage As Visio.Page) As Boolean
On Error Resume Next
Dim vsoLayer As Visio.Layer
Set vsoLayer = vsoPage.Layers(strThisLayer)
On Error GoTo 0
isLayer = IIf(vsoLayer Is Nothing, False, True)
End Function