Cant glue to shape in group Visio VBA

Question

I want to glue a shape to another one via VBA. All the shapes are created with an UserForm Module. I want certain shapes to be connected with an arrow (which is also dropped on the page via an UserForm). It works fine connecting two shapes which are not in a group. Now I want to connect two shapes where one or both of them may be in a Group.

This works fine with non-grouped shapes

'get shp, src, aim
[...]
shp.Cells("BeginX").GlueTo src.Cells("PinX")
shp.Cells("EndX").GlueTo aim.Cells("PinX")

I get the aim and src Shapes using this function:

Function getShape(id As Integer, propName As String) As Shape
    Dim shp As Shape
    Dim subshp As Shape
    For Each shp In ActivePage.Shapes
        If shp.Type = 2 Then
            For Each subshp In shp.GroupItems
                If subshp.CellExistsU(propName, 0) Then
                    If subshp.CellsU(propName).ResultIU = id Then
                        Set getShape = subshp
                        Exit For
                    End If
                End If
            Next subshp
        End If

        If shp.CellExistsU(propName, 0) Then
            If shp.CellsU(propName).ResultIU = id Then
                Set getShape = shp
                Exit For
            End If
        End If
    Next
End Function

I think there is something wrong with how I iterate through the subshapes. Any help is appreciated.

Answer 1

Ah, @Surrogate beat me to it :) but since I've started writing...in addition to his answer, which shows nicely how to adapt the built in Dynamic connector here's a go with your group finding method + a custom connector.

The code assumes a few things:

1. a page with two 2D shapes already dropped
2. one of the shapes is a group shape containing a subshape with the correct Shape Data
3. A custom master named 'MyConn' which is simple a 1D line with no other modifications

Public Sub TestConnect()
Dim shp As Visio.Shape 'connector
Dim src As Visio.Shape 'connect this
Dim aim As Visio.Shape 'to this

Dim vPag As Visio.Page
Set vPag = ActivePage

Set shp = vPag.Drop(ActiveDocument.Masters("MyConn"), 1, 1)
shp.CellsU("ObjType").FormulaU = 2
Set src = vPag.Shapes(1)

Set aim = getShape(7, "Prop.ID")

If Not aim Is Nothing Then
    shp.CellsU("BeginX").GlueTo src.CellsU("PinX")
    shp.CellsU("EndX").GlueTo aim.CellsU("PinX")
End If

End Sub


Function getShape(id As Integer, propName As String) As Shape
        Dim shp As Shape
        Dim subshp As Shape
        For Each shp In ActivePage.Shapes
            If shp.Type = 2 Then
                For Each subshp In shp.Shapes
                    If subshp.CellExistsU(propName, 0) Then
                        If subshp.CellsU(propName).ResultIU = id Then
                            Set getShape = subshp
                            Exit For
                        End If
                    End If
                Next subshp
            End If

            If shp.CellExistsU(propName, 0) Then
                If shp.CellsU(propName).ResultIU = id Then
                    Set getShape = shp
                    Exit For
                End If
            End If
        Next
    End Function

Note that if you read the docs for Cell.GlueTo, you'll see this item:

The pin of a 2-D shape (creates dynamic glue): The shape being glued from must be routable (ObjType includes visLOFlagsRoutable ) or have a dynamic glue type (GlueType includes visGlueTypeWalking ), and does not prohibit dynamic glue (GlueType does not include visGlueTypeNoWalking ). Gluing to PinX creates dynamic glue with a horizontal walking preference and gluing to PinY creates dynamic glue with a vertical walking preference.

and hence why I'm setting the ObjType cell to 2 (VisCellVals.visLOFlagsRoutable). Normally you'd set this in your master instance and so wouldn't need that line of code.