Cmd.CommandText = "Select * FROM CONPOINT"
Cmd.CommandType = adCmdText
With Rst
        .Open Source:=Cmd, CursorType:=adOpenStatic, LockType:=adLockOptimistic
        If .RecordCount > 0 Then
           .MoveFirst
           Do While Not .EOF
              intRowIndex = sh.AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt) 
              Set vsoRow = sh.Section(visSectionConnectionPts).Row(intRowIndex)
              vsoRow.Cell(visCnnctX).Formula = !x
              vsoRow.Cell(visCnnctY).Formula = !y
              .MoveNext
           Loop
        End If
        .Close
End With

quote:

---

Originally posted by Tumanov

А больше ничего в это время не работает? Например, какие-то обработчики событий, которые могут изменить ситуацию...

---

'вывод коннекторов, начиная с самого высокого уровня и до самого низкого
For i = 1 To NumOfTypesCon
    'Выборка коннекторов уровня i с выбранной страницы
    Cmd.CommandText = "Select * FROM CONNECTOR,TYPECON  where Connector.idtypecon = TypeCon.idtypecon AND Connector.IDPAG=(SELECT IDPAG FROM PAG WHERE NUMPAG='" & PAG & "') AND Connector.IDTYPECON='" & i & "'"
    Cmd.CommandType = adCmdText
    With Rst
       .Open Source:=Cmd, CursorType:=adOpenStatic, LockType:=adLockOptimistic
        If .RecordCount > 0 Then
            .MoveFirst
            Do While Not .EOF 'Вывод на страницу всех коннекторов из выборки
                 Set sh = ActivePage.Drop(Application.Documents.Item("ДИПЛОМ.vss").Masters.ItemU("" & !NAMETYPECON & ""), 0, 0)
                 sh.Name = !SHAPENAME
                 sh.Cells("BeginX").Formula = !BeginX
                 sh.Cells("BeginY").Formula = !BeginY
                 sh.Cells("EndX").Formula = !EndX
                 sh.Cells("EndY").Formula = !EndY
                 'Проверка, существуют ли у данного коннектора точки соединения
                 Cmd.CommandText = "Select * FROM CONPOINT WHERE IDSHAPE=" & !IDSHAPE & ""
                 Cmd.CommandType = adCmdText
                 With Rst2
                    .Open Source:=Cmd, CursorType:=adOpenStatic, LockType:=adLockOptimistic
                     If .RecordCount > 0 Then
                     'Если есть точки соединения
                         .MoveFirst
                         Do While Not .EOF
                            intRowIndex = sh.AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt) 'добавление точки
                            Set vsoRow = sh.Section(visSectionConnectionPts).Row(intRowIndex)
                            vsoRow.Cell(visCnnctX).Formula = !x                                                               
                            vsoRow.Cell(visCnnctY).Formula = !y
                            .MoveNext
                         Loop
                     End If
                     .Close
                 End With
                 
                 .MoveNext
            Loop
        End If
        .Close
    End With
Next
End Sub