Sub Вариант_1()
    Dim c_x1y1 As Range, c_x2y2 As Range, x#, y#, i%, h#
    
    lastcol = Cells(2, Columns.Count).End(xlToLeft).Column
    
    Set c_x1y1 = Range(Cells(2, 2), Cells(3, lastcol))
    Set c_x2y2 = Range(Cells(6, 2), Cells(7, lastcol))
    
    With ActiveSheet.Shapes
        On Error Resume Next
        i = 1
        Do While Err = 0
            .Item("line " & i).Delete
            .Item("label " & i).Delete
            i = i + 1
        Loop
        On Error GoTo 0
        For i = 1 To lastcol - 1
            x = c_x1y1(1, i) + (c_x2y2(1, i) - c_x1y1(1, i) - c_x1y1(1, 1).Width) / 2
            y = c_x1y1(2, i) + (c_x2y2(2, i) - c_x1y1(2, i) - c_x1y1(7, 1).Height) / 2
            With .AddConnector(1, c_x1y1(1, i), c_x1y1(2, i), c_x2y2(1, i), c_x2y2(2, i))
                .Name = "line " & i
            End With
            With .AddTextbox(1, x, y, c_x1y1(1, i).Width, c_x1y1(7, i).Height)
                .Name = "label " & i
                h = .Height
                With .TextFrame
                    .Characters.Text = c_x1y1(7, i)
                    .HorizontalAlignment = xlHAlignCenter
                    .VerticalAlignment = xlVAlignCenter
                    .MarginBottom = 0: .MarginLeft = 0
                    .MarginRight = 0: .MarginTop = 0
                    .AutoSize = True
                End With
                If .Height <> h Then .Top = .Top - (.Height - h) / 2
            End With
        Next i
    End With
End Sub