try this
' we needed an add connections routine for the drawing of the trace routes
' this is called by the following routine to add a standard set of
' connections to the rectangles used
Public Function funcAddConnectionPointToShape(vsoShape As Visio.Shape, _
strLocalRowName As String, _
strRowNameU As String, _
strLabelName As String, _
strConnectType As String, _
strX As String, _
strY As String, _
Optional strDirX As String, _
Optional strDirY As String, _
Optional blnAutoGen As Boolean) As Boolean
Dim vsoCell As Visio.Cell
Dim intRowIndex As Integer
Dim strCurrentTask As String ' for debug
On Error GoTo AddConnectionPt_Err
intRowIndex = vsoShape.AddNamedRow(visSectionConnectionPts, _
strLocalRowName, VisRowIndices.visRowConnectionPts)
If (strLocalRowName <> strRowNameU And _
Len(strRowNameU) > 0) Then
vsoCell.RowNameU = strRowNameU
End If
' 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
funcAddConnectionPointToShape = True
Exit Function
AddConnectionPt_Err:
If Err > 0 Then
Debug.Print "Err in funcAddConnectionPointToShape " & Err & " " &
Err.Description & " " & strCurrentTask
funcAddConnectionPointToShape = False
End If
End Function
Public Sub subAddStandardConnections(visShape As Visio.Shape)
Dim visSection As Integer
Dim blnResult As Boolean
On Error GoTo AddStandardConnections_Err
visSection = visSectionConnectionPts
visShape.AddSection visSection
' since we have connections on all four sides we probably dont need a
middle
' blnResult = funcAddConnectionPointToShape(visShape, "Middle",
"Middle", "Middle", _
2, "Width * 0.5", "Height * 0.5", 0, False)
blnResult = funcAddConnectionPointToShape(visShape, "Left", "Left",
"Left", _
2, "0", "Height * 0.5", 0, False)
blnResult = funcAddConnectionPointToShape(visShape, "Right", "Right",
"Right", _
2, "Width", "Height * 0.5", 0, False)
blnResult = funcAddConnectionPointToShape(visShape, "Top", "Top", "Top",
_
2, "Width * 0.5", "Height", 0, False)
blnResult = funcAddConnectionPointToShape(visShape, "Bottom", "Bottom",
"Bottom", _
2, "Width * 0.5", "0", 0, False)
Exit Sub
AddStandardConnections_Err:
End Sub
