Option Explicit
Public what As String
Public forwhat As String
Public checkCase As Boolean
Public exitPoint As Boolean
Public CaRet As String

Sub RightTypography()
    CleanUp
    If exitPoint Then
        Exit Sub
    End If
    NMDash
    NoBreak
End Sub

Sub SimpleReplace(what, forwhat, checkCase)
    exitPoint = False
    With Selection
        With .Find
            .ClearFormatting
            .Text = what
            .Replacement.ClearFormatting
            .Replacement.Text = forwhat
            .Forward = True
            .Wrap = wdFindContinue
            .MatchCase = checkCase
            .Execute Replace:=wdReplaceAll
            If Not .Found Then
                exitPoint = True
            End If
        End With
    End With
End Sub

Sub CleanUp()
    CaRet = Chr(10) + Chr(13)
    If MsgBox("Пустая строка в конце документа приводит к зацикливанию макроса." _
            & CaRet & "Прервать выполнение макроса для ручной проверки?", vbYesNo, "") = vbYes Then
        exitPoint = True
        Selection.EndKey Unit:=wdStory
        Exit Sub
    Else
        exitPoint = False
        Selection.HomeKey Unit:=wdStory
    End If
    ' deletion tabs
        If MsgBox("Удаляем табуляцию?", vbYesNo, "") = vbYes Then
            SimpleReplace "^t", " ", True
        End If
    ' punctuation spaces
    If MsgBox("Упорядочить пробелы при знаках препинания?", vbYesNo, "") = vbYes Then
        SimpleReplace "(", " (", True
        SimpleReplace "( ", "(", True
        SimpleReplace ")", ") ", True
        SimpleReplace " )", ")", True
        SimpleReplace "- (", "-(", True
        SimpleReplace ") -", ")-", True
        SimpleReplace "!", "! ", True
        SimpleReplace " !", "!", True
        SimpleReplace "?", "? ", True
        SimpleReplace " ?", "?", True
        SimpleReplace ".", ". ", True
        SimpleReplace " .", ".", True
        SimpleReplace ",", ", ", True
        SimpleReplace " ,", ",", True
        SimpleReplace ":", ": ", True
        SimpleReplace " :", ":", True
        SimpleReplace ". ru", ".ru", True
        SimpleReplace ". com", ".com", True
        SimpleReplace ". net", ".net", True
        SimpleReplace ". org", ".org", True
        With Selection
            .EndKey Unit:=wdStory
            .TypeBackspace
        End With
    End If
    ' deletion double spaces
    Do
        SimpleReplace "  ", " ", True
        If exitPoint Then
            Exit Do
        End If
    Loop
    ' deletion spaces which start a paragraph
        SimpleReplace "^p ", "^p", True
    ' deletion spaces which end a paragraph
        SimpleReplace " ^p", "^p", True
    ' deletion manual line breaks
        SimpleReplace "^l", "^p", True
    ' deletion blank lines
    Do
        SimpleReplace "^p^p", "^p", True
        If exitPoint Then
            Exit Do
        End If
    Loop
    exitPoint = False
End Sub

Sub NMDash()
    ' m-dash as a punctuation mark
    SimpleReplace " - ", " ^+ ", True
    SimpleReplace " ^= ", " ^+ ", True
    ' m-dash as a dialogue mark
    SimpleReplace "^p- ", "^p^+ ", True
    SimpleReplace "^p^= ", "^p^+ ", True
    ' n-dash as an interspace
    If MsgBox("Постановка интервального тире выполняется экстенсивно." _
            & CaRet & "Продолжить (Да), пропустить (Нет)?", vbYesNo, "") = vbYes Then
        Do
            With Selection
                .HomeKey Unit:=wdStory
                With .Find
                    .ClearFormatting
                    .Forward = True
                    .Wrap = wdFindStop
                    .Text = "^#-^#"
                    .Execute
                    If Not .Found Then
                        Exit Do
                    End If
                End With
                .MoveLeft
                .MoveRight
                .Delete
                .TypeText ("–")
            End With
        Loop
    End If
    ' omission dots sign istead of three points
    SimpleReplace "...", "…", True
End Sub

Sub NoBreak()
    ' deabbreviation
    SimpleReplace "т.е.", "то есть", True
    SimpleReplace "т. е.", "то есть", True
    SimpleReplace "Т.е.", "То есть", True
    SimpleReplace "Т. е.", "то есть", True
    SimpleReplace "в т.ч.", "в том числе", True
    SimpleReplace "в т. ч.", "в том числе", True
    ' nbsp in abbreviations
    SimpleReplace "и т.д.", "и^sт.^sд.", True
    SimpleReplace "И т.д.", "И^sт.^sд.", True
    SimpleReplace "и т.п.", "и^sт.^sп.", True
    SimpleReplace "И т.п.", "И^sт.^sп.", True
    SimpleReplace "г.х.", "г.^sх.", True
    SimpleReplace "н.э.", "н.^sэ.", True
    SimpleReplace "и т. д.", "и^sт.^sд.", True
    SimpleReplace "И т. д.", "И^sт.^sд.", True
    SimpleReplace "и т. п.", "и^sт.^sп.", True
    SimpleReplace "И т. п.", "И^sт.^sп.", True
    SimpleReplace "г. х.", "г.^sх.", True
    SimpleReplace "н. э.", "н.^sэ.", True
    ' nbsp after prepositions
    SimpleReplace " в ", " в^s", True
    SimpleReplace " В ", " В^s", True
    SimpleReplace " к ", " к^s", True
    SimpleReplace " К ", " К^s", True
    SimpleReplace " о ", " о^s", True
    SimpleReplace " О ", " О^s", True
    SimpleReplace " с ", " с^s", True
    SimpleReplace " С ", " С^s", True
    SimpleReplace " у ", " у^s", True
    SimpleReplace " У ", " У^s", True
    SimpleReplace "(в ", "(в^s", True
    SimpleReplace "(В ", "(В^s", True
    SimpleReplace "(к ", "(к^s", True
    SimpleReplace "(К ", "(К^s", True
    SimpleReplace "(о ", "(о^s", True
    SimpleReplace "(О ", "(О^s", True
    SimpleReplace "(с ", "(с^s", True
    SimpleReplace "(С ", "(С^s", True
    SimpleReplace "(у ", "(у^s", True
    SimpleReplace "(У ", "(У^s", True
    ' nbsp after conjunctions
    SimpleReplace " а ", " а^s", True
    SimpleReplace " А ", " А^s", True
    SimpleReplace " и ", " и^s", True
    SimpleReplace " И ", " И^s", True
    ' nbsp after pronoms
    SimpleReplace " я ", " я^s", True
    SimpleReplace " Я ", " Я^s", True
    ' nbsp before dash
    SimpleReplace " ^+", "^s^+", True
    ' nbsp after digits and number sign, and before percent sign, and before slash
    SimpleReplace "%", "^s%", True
    SimpleReplace "№", "№^s", True
    SimpleReplace "^# ", "^&^s", True
    SimpleReplace " ^s", "^s", True
    SimpleReplace "^s ", "^s", True
    SimpleReplace " /", "^s/", True
End Sub