Function TrimText(text As String, Count As Long, Optional TrimComma As Boolean = True, Optional SpaceComma As String) As String
'
'Функция возвращает подстроку состоящую из целых слов, суммарная длина которой не превышает заданное значениче
'Обязательный аргумент Text - исходная сторока
'Обязательный аргумент Count - максимальное количество символов, составляющих подстроку
'Необязательный аргумент TrimComma - если истина с конца подстроки удаляются пробел и следующие символы: ,\-=;№#@:+({<[_
'Необязательный аргумент SpaceComma - введенная без разделителей строка с сисмволами, которые в любом случае
'будут отделены от предыдущего символа пробелом

Dim Obj As Object
Dim I As Long
With CreateObject("VBScript.RegExp")
    .Pattern = "\s"
    If .test(text) Then text = .Replace(text, " ")
    If SpaceComma <> "" Then
        .Pattern = "[" & SpaceComma & "]"
        Set Obj = .Execute(text)
        For I = 0 To Obj.Count - 1
            text = .Replace(text, " " & Obj.Item(I))
        Next
    End If
    .Pattern = " {2,}"
    If .test(text) Then text = .Replace(text, " ")
    If Len(text) <= Count Then
        TrimText = text
        Exit Function
    End If
    .Pattern = "^.{1," & Count & "} "
    If .test(text) Then text = .Execute(text)(0)
    If TrimComma Then .Pattern = "[,\-=;№#@:\+({<\[_ ]+$" Else .Pattern = " $"
    If .test(text) Then text = .Replace(text, "")
    TrimText = text
End With
End Function