Option Explicit

Enum LexicalUnits
    luRoot = 0
    luPrefix = 1
    luPostfix = 2
    luEndfix = 3
End Enum

'Вставить корень
Sub корень()
    Call AddLexicalUnit(luRoot)
End Sub

'Вставить приставку
Sub приставка()
    Call AddLexicalUnit(luPrefix)
End Sub

'Вставить суффикс
Sub суффикс()
    Call AddLexicalUnit(luPostfix)
End Sub

'Вставить окончание
Sub окончание()
    Call AddLexicalUnit(luEndfix)
End Sub

Sub AddLexicalUnit(LexUnit As LexicalUnits)
    Dim nL As Single, nT As Single, nW As Single, nH As Long
    Const HEIGHT As Single = 3
'    ActiveWindow.GetPoint 0, 0, 0, nH, Selection.Range
    nL = Selection.Information(wdHorizontalPositionRelativeToPage)
    nT = Selection.Information(wdVerticalPositionRelativeToPage) + 2
    Selection.Collapse wdCollapseEnd
    nW = Selection.Information(wdHorizontalPositionRelativeToPage) - nL
    Select Case LexUnit
        Case luRoot 'Корень
            With ActiveDocument.Shapes.BuildFreeform(msoEditingAuto, CSng(nL), CSng(nT))
                .AddNodes msoSegmentCurve, msoEditingAuto, CSng(nL + nW / 2 - 1), CSng(nT - HEIGHT)
                .AddNodes msoSegmentCurve, msoEditingAuto, CSng(nL + nW - 2), CSng(nT)
                .ConvertToShape.Select
            End With
        Case luPrefix 'Приставка
            With ActiveDocument.Shapes.BuildFreeform(msoEditingAuto, CSng(nL), CSng(nT))
                .AddNodes msoSegmentLine, msoEditingAuto, CSng(nL + nW - 2), CSng(nT)
                .AddNodes msoSegmentLine, msoEditingAuto, CSng(nL + nW - 2), CSng(nT + 2 * HEIGHT / 3)
                .ConvertToShape.Select
            End With
        Case luPostfix 'Суффикс
            With ActiveDocument.Shapes.BuildFreeform(msoEditingAuto, CSng(nL), CSng(nT))
                .AddNodes msoSegmentLine, msoEditingAuto, CSng(nL + nW / 2 - 1), CSng(nT - HEIGHT)
                .AddNodes msoSegmentLine, msoEditingAuto, CSng(nL + nW - 2), CSng(nT)
                .ConvertToShape.Select
            End With
        Case luEndfix 'Окончание
            nH = Selection.Font.Size
            With ActiveDocument.Shapes.AddShape(msoShapeRectangle, nL, nT, nW, CSng(nH))
                .Fill.Visible = msoFalse
                .Select
            End With
    End Select
    Selection.ShapeRange.WrapFormat.Type = 3
End Sub