Iterates through shapes on page and modifies master shape by clearing all connection points and adding connection point to bottom,right,top,left. Very specific to a certain shape size (1.5" width, 0.5" height)

VisioShapeModifier.vba

Public Sub OpenMaster_Example()
 
    Dim vsoMaster As Visio.Master
    Dim vsoMasterCopy As Visio.Master
    Dim vsoShape As Visio.Shape
    Dim vsoCell As Visio.Cell
    Dim success As Boolean
    
    On Error GoTo ErrorHandler
    
    For x = 1 To Visio.ActiveDocument.Masters.Count
    
       Set vsoMaster = Visio.ActiveDocument.Masters(x)
       
       Set vsoMasterCopy = vsoMaster.Open
    
       For i = 1 To vsoMasterCopy.Shapes.Count
           Set vsoShape = vsoMasterCopy.Shapes.Item(i)
           If vsoShape.SectionExists(visSectionConnectionPts, False) = True Then
               vsoShape.DeleteSection (visSectionConnectionPts)
           End If
           myWidth = vsoShape.Cells("Width")
           If myWidth >= 1.5 Then
               success = AddConnectionPointToShape(vsoShape, "Bottom", "", "Width*0.5", "Height*0", "0 in", "1 in", False)
               success = AddConnectionPointToShape(vsoShape, "Right", "", "Width*1", "Height*0.5", "-1 in", "0 in", False)
               success = AddConnectionPointToShape(vsoShape, "Top", "", "Width*0.5", "Height*1", "0 in", "-1 in", False)
               success = AddConnectionPointToShape(vsoShape, "Left", "", "Width*0", "Height*0.5", "1 in", "0 in", False)
            End If
       Next i
       
ErrorHandler:
       vsoMasterCopy.Close
    Next x
 
End Sub



Public Function AddConnectionPointToShape(ByVal vsoShape As Visio.Shape, _
                    ByVal strLocalRowName As String, _
                    ByVal strConnectType As String, _
                    ByVal strX As String, _
                    ByVal strY As String, _
                    Optional ByVal strDirX As String = "", _
                    Optional ByVal strDirY As String = "", _
                    Optional ByVal blnAutoGen As Boolean = False) _
                    As Boolean
                    
       Dim vsoCell As Visio.Cell
        Dim intRowIndex As Integer

            If vsoShape.SectionExists(visSectionConnectionPts, False) = False Then
                vsoShape.AddSection (visSectionConnectionPts)
            End If

            intRowIndex = vsoShape.AddNamedRow(visSectionConnectionPts, _
                 strLocalRowName, _
                 Visio.VisRowIndices.visRowConnectionPts)

            ' Column 0: X
            Set vsoCell = vsoShape.CellsSRC(visSectionConnectionPts, _
                visRowConnectionPts + intRowIndex, visX)
            vsoCell.Formula = strX

            ' Column 1: Y
            Set vsoCell = vsoShape.CellsSRC(visSectionConnectionPts, _
                visRowConnectionPts + intRowIndex, visY)
            vsoCell.Formula = strY

            ' Column 2: direction x
            Set vsoCell = vsoShape.CellsSRC(visSectionConnectionPts, _
                visRowConnectionPts + intRowIndex, visCnnctDirX)
            vsoCell.Formula = strDirX

            ' Column 3: direction y
            Set vsoCell = vsoShape.CellsSRC(visSectionConnectionPts, _
                visRowConnectionPts + intRowIndex, visCnnctDirY)
            vsoCell.Formula = strDirY

            ' Column 4: type
            Set vsoCell = vsoShape.CellsSRC(visSectionConnectionPts, _
                visRowConnectionPts + intRowIndex, visCnnctType)
            vsoCell.Formula = strConnectType

            ' Column 5: autogen
            Set vsoCell = vsoShape.CellsSRC(visSectionConnectionPts, _
                visRowConnectionPts + intRowIndex, visCnnctAutoGen)
            vsoCell.ResultIU = blnAutoGen

            AddConnectionPointToShape = True
                    
End Function