quote:

---

в макрос какая то ошибка закралась ?

---

Макрос не просматривал. Слишком много понаписано...

Public Function ConnectedCells(ByVal sh As Visio.Shape)

Dim strFrom(), strTo() As String
Dim vsoConnectTo(), vsoConnectFrom() As Visio.Shape
Dim intCounter, extCounter As Integer
intCounter0 = 0
extCounter0 = 0

    For k = 0 To 1
            Select Case k
            Case 0
            Set vsoConnects = sh.Connects
            Case 1
            Set vsoConnects = sh.FromConnects
            End Select

        'For each connection, get the shape it connects to
        'and the part of the shape it connects to,
        'and print that information in the Immediate window.
        For intCounter = intCounter0 To (intCounter0 + vsoConnects.Count - 1)
            ReDim Preserve strTo(intCounter + 1), vsoConnectTo(intCounter + 1)
            
            Debug.Print vsoConnects.Count & " " & intCounter
            Set vsoConnect = vsoConnects(intCounter - intCounter0 + 1)
            Set vsoConnectTo(intCounter) = vsoConnect.ToSheet
            intToData = vsoConnect.ToPart

            If intToData = visConnectError Then
                strTo(intCounter) = "error"
            ElseIf intToData = visNone Then
                strTo(intCounter) = "none"
            ElseIf intToData = visGuideX Then
                strTo(intCounter) = "guideX"
            ElseIf intToData = visGuideY Then
                strTo(intCounter) = "guideY"
            ElseIf intToData = visWholeShape Then
                strTo(intCounter) = "dynamic glue"
            ElseIf intToData >= visConnectionPoint Then
                strTo(intCounter) = "connection point " & _
                    CStr(intToData - visConnectionPoint + 1)
            Else
                strTo(intCounter) = "???"
            End If

            'Print the name and part of the shape the
            'Connect object connects to.
           ' Debug.Print "To " & vsoConnectTo(intCounter).Name & " " & strTo(intCounter) & "."
    Next intCounter

intCounter0 = intCounter

        'For each connection, get the shape it originates from
        'and the part of the shape it originates from,
        'and print that information in the Immediate window.
        For extCounter = extCounter0 To extCounter0 + vsoConnects.Count - 1
            ReDim Preserve strFrom(extCounter + 1), vsoConnectFrom(extCounter + 1)
            Set vsoConnect = vsoConnects(extCounter - extCounter0 + 1)
            Set vsoConnectFrom(extCounter) = vsoConnect.FromSheet
            intFromData = vsoConnect.FromPart
            
'Debug.Print "vsoFrom " & vsoConnectFrom(extCounter).Name

            'FromPart property values
            If intFromData = visConnectError Then
                strFrom(extCounter) = "error"
            ElseIf intFromData = visNone Then
                strFrom(extCounter) = "none"
            ElseIf intFromData = visLeftEdge Then
                strFrom(extCounter) = "left"
            ElseIf intFromData = visCenterEdge Then
                strFrom(extCounter) = "center"
            ElseIf intFromData = visRightEdge Then
                strFrom(extCounter) = "right"
            ElseIf intFromData = visBottomEdge Then
                strFrom(extCounter) = "bottom"
            ElseIf intFromData = visMiddleEdge Then
                strFrom(extCounter) = "middle"
            ElseIf intFromData = visTopEdge Then
                strFrom(extCounter) = "top"
            ElseIf intFromData = visBeginX Then
                strFrom(extCounter) = "beginX"
            ElseIf intFromData = visBeginY Then
                strFrom(extCounter) = "beginY"
            ElseIf intFromData = visBegin Then
                strFrom(extCounter) = "begin"
            ElseIf intFromData = visEndX Then
                strFrom(extCounter) = "endX"
            ElseIf intFromData = visEndY Then
                strFrom(extCounter) = "endY"
            ElseIf intFromData = visEnd Then
                strFrom(extCounter) = "end"
            ElseIf intFromData >= visControlPoint Then
                strFrom(extCounter) = "controlPt_" & _
                    str(intFromData - visControlPoint + 1)
            Else
                strFrom(extCounter) = "???"
            End If

          '  Debug.Print "From " & vsoConnectFrom(extCounter).Name & " " & strFrom(extCounter)

        Next extCounter
extCounter0 = extCounter
Next k

    ConnectedCells1 = Array(vsoConnectTo, strTo, vsoConnectFrom, strFrom)

        If False Then 'debug
        For j = 0 To UBound(ConnectedCells1) - 1
            ar = ConnectedCells1(j)
            text = ""
            For I = 0 To UBound(ar) - 1
            text = text & ar(I) & "  "
            Next I
            'Debug.Print j & " " & text
        Next j
        End If
    ConnectedCells = ConnectedCells1
End Function