VBA code to fill labels on shape data

[ltaretti]

Hey guys, Im on a visio's project in my company and I have to develop an export that shows the equipaments and its connections. I searched on internet and found a VBA code that creat prop.From and prop.To in every shape on the page, but those labels appear without value. I want to improve the VBA code that I found, I must find a way to fill those labels with connections of the shape, I mean, in the prop.From I want that somehow the macro fill the label with where the connection comes.

Thanks.

The code:

Sub GetFlowchartConnections()
' Gets text from shapes connected at each end of every line on page
' Stores text in two shape data fields on each line

    Dim pg As Visio.Page
    Dim shp As Visio.shape
    Dim cnxEndPoints As Visio.Connects
    Dim EP As Visio.Connect
    Dim shpFrom As Visio.shape
    Dim shpTo As Visio.shape
   
    For Each pg In ActiveDocument.Pages
        For Each shp In pg.Shapes
            Call InitFromTo(shp)
           
            ' BeginX only exists if shape is a line
            If shp.CellExists("BeginX", False) Then
                'Get connects collection for current shape
                Set cnxEndPoints = shp.Connects
               
                If cnxEndPoints.Count > 0 Then
                    For i = 1 To cnxEndPoints.Count
                        Set EP = cnxEndPoints(i)
                        If EP.FromPart = visBegin Then
                            ' Get shape this end is attached to
                            Set shpFrom = EP.ToSheet
                            ' Store attached shape's text
                            shp.CellsU("Prop.From").FormulaU = Chr(34) & shpFrom.Text & Chr(34)
                        Else
                            ' Get shape this end is attached to
                            Set shpTo = EP.ToSheet
                            ' Store attached shape's text
                            shp.CellsU("Prop.To").FormulaU = Chr(34) & shpTo.Text & Chr(34)
                        End If
                    Next
                End If
            End If
        Next
    Next

End Sub
Private Sub InitFromTo(ByRef shape As Visio.shape)
' Create Prop.From/To if they don't exist
' Set both fields to null

    If Not shape.CellExistsU("Prop.From", False) Then
        shape.AddNamedRow visSectionProp, "From", visdefault
    End If
    shape.CellsU("Prop.From").FormulaU = ""
    shape.CellsU("Prop.From.Label").FormulaU = Chr(34) & "From" & Chr(34)
   
    If Not shape.CellExistsU("Prop.To", False) Then
        shape.AddNamedRow visSectionProp, "To", visdefault
    End If
    shape.CellsU("Prop.To").FormulaU = ""
    shape.CellsU("Prop.To.Label").FormulaU = Chr(34) & "To" & Chr(34)

End Sub

[Surrogate]

about 5 years ago I shared in that thread same document with code which create table of connection in Excel.

[wapperdude]

See reply #5, this post:  http://visguy.com/vgforum/index.php?topic=8236.msg35642;topicseen#msg35642

Wapperdude