Макрос выделения приставки, корня, суффикса и окончания в Word

Как в Word графически выделить приставку, корень, суффикс и окончание в нужном слове (как на уроках русского языка)?

Этот вопрос задал мне один из подписчиков на YouTube канале. И я решил записать видео на эту тему. Ведь многим может стать полезным умение делать разбор слова на части в программе MS Word.

Как в Word выделить приставку, корень, суффикс, окончание и основу. Видео

Как в Word выделить приставку, корень, суффикс, окончание и основу с помощью макросов и VBA

А именно, создадим:

1. Макрос Приставка в Word.
2. Макрос Суффикс в Word.
3. Макрос Корень в Word.
4. Макрос Окончание в Word.

Для этого:

• Запустите MS Word.
• Перейдите на вкладку Разработчик. Если этой вкладки нет, то нужно её включить, выбрав Файл → Параметры → Настроить ленту и отметив галочкой пункт Разработчик.

• На вкладке Разработчик нажмите на кнопку Запись макроса.
• В появившемся окне введите любое имя макроса и нажмите ОК.

• Нажмите Остановить запись.

• На вкладке Разработчик нажмите по иконке Макросы.

• В появившемся окне выберите тот макрос, который вы создали ранее и нажмите Изменить.

• В появившемся окне выделите код текущего макроса и замените его на указанный ниже код VBA для выделения приставки, корня, суффикса и окончания в Word.

Будьте внимательны. Вам нужно заменить только тот код который относится к созданному ранее макросу. Если у вас есть другие макросы в Word, то их код удалять не нужно.

Код VBA для выделения приставки, корня, суффикса и окончания в Word

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