Версия для печати темы

Sub FixText()
'
' оптимизация выделенного текста
' Макрос записан 01.06.2008 HETMAN ( post . box @ tut . by )
'
Dim stext$, ff%, ss$
    stext = Selection.Text ' заносим выделенный текст в переменную
    ff = 1
    Do While InStr(1, stext, "  ", vbTextCompare) <> 0 'очищаем от лишних пробелов
        stext = Replace$(stext, "  ", " ")
    Loop
    stext = Replace$(stext, vbCr & vbCr, vbCr)  'очищаем от лишних пустых строк¶
    stext = Replace$(stext, vbCr & " ", vbCr)  'ещё одна очистка

    Do While ff <> 0
        ' ищим знак конца абзаца - ¶
        ff = InStr(ff, stext, vbCr, vbTextCompare)

        If ff <> 0 Then 'если нашли
            ss = Mid$(stext, ff + 1, 1) ' заносим последующий сивол в переменную
            If ss <> UCase$(ss) Or ss = "(" Or ss = "«" Or ss = "[" Then ' провераяем является ли это концом абзаца
                stext = Left$(stext, ff - 1) & " " & Mid$(stext, ff + 1, Len(stext) - ff - 1)
            Else
            End If
            If ss = "-" Then ' провераяем является ли это концом абзаца
                stext = Left$(stext, ff - 1) & Mid$(stext, ff + 1, Len(stext) - ff - 1)
            Else
                ff = ff + 1
            End If
        End If
    Loop
    ' заменяем выделенный текст обработанным
    Selection.Delete
    Selection.InsertAfter (stext)
End Sub