---

Sub ShakerSortFlowchart()
    Dim doc As Document
    Set doc = ActiveDocument
    
    Dim shp As Shape
    Dim prev As Shape
    Dim x As Single, y As Single
    Dim w As Single, h As Single
    Dim gap As Single
    Dim conn As Shape
    
    ' Параметры фигур
    w = 180: h = 50: gap = 40
    x = 100: y = 40
    
    Dim shapesArr() As Shape
    ReDim shapesArr(0 To 20)
    Dim i As Integer
    i = 0
    
    ' 1. Начало
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartTerminator, x, y, w, h, "Начало")
    i = i + 1
    y = y + h + gap
    
    ' 2. Ввод массива A[1..n]
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartData, x, y, w, h, "Ввод массива A[1..n]")
    i = i + 1
    y = y + h + gap
    
    ' 3. left = 1, right = n
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartProcess, x, y, w, h, "left = 1; right = n")
    i = i + 1
    y = y + h + gap
    
    ' 4. swap = false
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartProcess, x, y, w, h, "swap = false")
    i = i + 1
    y = y + h + gap
    
    ' 5. Цикл влево: i = left..right-1
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartProcess, x, y, w, h, "i = left .. right-1")
    i = i + 1
    y = y + h + gap
    
    ' 6. Условие A[i] > A[i+1]
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartDecision, x, y, w, h, "A[i] > A[i+1] ?")
    i = i + 1
    y = y + h + gap
    
    ' 7. Обмен
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartProcess, x, y, w, h, "Обмен A[i] и A[i+1]" & vbCrLf & "swap = true")
    i = i + 1
    y = y + h + gap
    
    ' 8. right = right - 1
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartProcess, x, y, w, h, "right = right - 1")
    i = i + 1
    y = y + h + gap
    
    ' 9. Цикл вправо: i = right..left+1 (шаг -1)
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartProcess, x, y, w, h, "i = right .. left+1 (шаг -1)")
    i = i + 1
    y = y + h + gap
    
    ' 10. Условие A[i-1] > A[i]
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartDecision, x, y, w, h, "A[i-1] > A[i] ?")
    i = i + 1
    y = y + h + gap
    
    ' 11. Обмен
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartProcess, x, y, w, h, "Обмен A[i-1] и A[i]" & vbCrLf & "swap = true")
    i = i + 1
    y = y + h + gap
    
    ' 12. left = left + 1
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartProcess, x, y, w, h, "left = left + 1")
    i = i + 1
    y = y + h + gap
    
    ' 13. Условие swap = true
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartDecision, x, y, w, h, "swap = true И left < right ?")
    i = i + 1
    y = y + h + gap
    
    ' 14. Вывод массива
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartData, x, y, w, h, "Вывод массива A[1..n]")
    i = i + 1
    y = y + h + gap
    
    ' 15. Конец
    Set shapesArr(i) = AddFlowShape(doc, msoShapeFlowchartTerminator, x, y, w, h, "Конец")
    Dim lastIdx As Integer
    lastIdx = i
    
    ' === Соединители (основная вертикальная линия) ===
    Dim k As Integer
    For k = 0 To lastIdx - 1
        ConnectShapes doc, shapesArr(k), shapesArr(k + 1)
    Next k
    
    ' === Обратные связи (пунктирные) ===
    ' От "Обмен A[i] и A[i+1]" (7) возврат к циклу (5)
    AddFeedback doc, shapesArr(6), shapesArr(4), "нет / продолжение"
    ' От условия (6) "нет" — вниз к (8) уже соединено, поэтому отдельная метка
    ' От условия (10) "нет" вниз к (12) уже соединено
    
    ' Возврат от "left = left + 1" (12) к "swap = false" (4)
    AddFeedback doc, shapesArr(11), shapesArr(3), "повтор"
    
    ' От условия (13) "да" — возврат к (4)
    AddFeedback doc, shapesArr(12), shapesArr(3), "да"
    
    MsgBox "Блок-схема построена!", vbInformation
End Sub

' ---------- Вспомогательные процедуры ----------

Function AddFlowShape(doc As Document, shpType As MsoAutoShapeType, _
                      x As Single, y As Single, w As Single, h As Single, _
                      txt As String) As Shape
    Dim s As Shape
    Set s = doc.Shapes.AddShape(shpType, x, y, w, h)
    With s
        .Fill.ForeColor.RGB = RGB(230, 240, 255)
        .Line.ForeColor.RGB = RGB(0, 70, 140)
        .Line.Weight = 1.25
        .TextFrame.TextRange.Text = txt
        .TextFrame.TextRange.Font.Size = 10
        .TextFrame.TextRange.Font.Bold = False
        .TextFrame.MarginTop = 2
        .TextFrame.MarginBottom = 2
        .TextFrame.VerticalAnchor = msoAnchorMiddle
        .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
    End With
    Set AddFlowShape = s
End Function

Sub ConnectShapes(doc As Document, fromShp As Shape, toShp As Shape)
    Dim c As Shape
    Set c = doc.Shapes.AddConnector(msoConnectorStraight, 0, 0, 0, 0)
    c.ConnectorFormat.BeginConnect fromShp, 3   ' низ исходной
    c.ConnectorFormat.EndConnect toShp, 1       ' верх целевой
    c.Line.ForeColor.RGB = RGB(0, 0, 0)
    c.Line.Weight = 1.25
    ' Стрелка
    c.Line.EndArrowheadStyle = msoArrowheadTriangle
End Sub

Sub AddFeedback(doc As Document, fromShp As Shape, toShp As Shape, label As String)
    Dim c As Shape
    Dim fx As Single, fy As Single, tx As Single, ty As Single
    
    ' Правая сторона исходной → правая сторона целевой
    fx = fromShp.Left + fromShp.Width
    fy = fromShp.Top + fromShp.Height / 2
    tx = toShp.Left + toShp.Width
    ty = toShp.Top + toShp.Height / 2
    
    Set c = doc.Shapes.AddConnector(msoConnectorElbow, fx, fy, tx + 60, ty)
    c.ConnectorFormat.BeginConnect fromShp, 4   ' правая исходной
    c.ConnectorFormat.EndConnect toShp, 4       ' правая целевой
    c.Line.ForeColor.RGB = RGB(180, 0, 0)
    c.Line.Weight = 1
    c.Line.DashStyle = msoLineDash
    c.Line.EndArrowheadStyle = msoArrowheadTriangle
    
    ' Подпись
    Dim lbl As Shape
    Set lbl = doc.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                    fx + 30, (fy + ty) / 2 - 8, 80, 16)
    lbl.TextFrame.TextRange.Text = label
    lbl.TextFrame.TextRange.Font.Size = 8
    lbl.TextFrame.TextRange.Font.Color = RGB(180, 0, 0)
    lbl.Fill.Visible = msoFalse
    lbl.Line.Visible = msoFalse
End Sub