Дата прописью в VBA. Практическое применение

Дата прописью в VBA. Практическое применение

Неплохо, когда есть множество онлайн сервисов которые могу преобразовывать численное значение дат в пропись Дата (день, месяц, год) прописью. Но все же у этих способов есть один неприятный недостаток. Например у вас есть много договоров в которые необходимо внести  изменения следующего толка, вместо дат  вида 02.04.2015, необходимо в скобках  прописать эту же дату прописью (второе апреля две тысячи пятнадцатого года)
 
Не очень удобно каждый раз, переключаясь в окно онлайн  калькулятора, вписывать необходимо дату и потом копировать/вставлять полученный результат.
 
Рассмотрим возможность упрощения данной процедуры, учитывая что у нас есть онлайн сервис который может отдать результат в том виде который нам необходим
 
В этой статье рассмотрим вариант как с помощью написанного макроса по "горячей клавише"  решить поставленную задачу. Естественно это основа и эту основу программисты VBA смогут расширить до достаточно удобного и красивого приложения если в этом будет необходимость. Вплоть до того что после написания даты макрос автоматически будет добавлять дату прописью  а не по нажатию "горячей клавиши".

Sub Макрос1()

body = Selection.Text
body = Replace(body, "-", "/")
body = Replace(body, ".", "/")
Dim sURL As String
Dim oHttp As Object
Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
sURL = "http://сервер бота"
oHttp.Open "POST", sURL, False
oHttp.setrequestheader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
oHttp.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
oHttp.send ("from=www&key=towo&body=" + body + "!2")
Result = oHttp.ResponseText
xxx = jdecoder(Result)
Dim words() As String
words = Split(xxx, ":")
otvet = ClearName(words(4), "[^а-я ]")
otvet1 = ClearName(words(3), "[^а-я ]")
Selection.EndOf
Selection.TypeText Text:="(" + otvet1 + ")"
End Sub
 
В первой части этого макроса он практически повторяет все то что рассказывалось в POST запрос через Excel  и Карточка сотрудника Active Directory через Excel поэтому останавливаться на этом не будем. Как написать макрос, как привязать горячую клавишу, это все описано в вышеупомянутых статьях.
 
Скажем лишь, что макрос за входные данные берет текст который был выделен и потом нажата горячая клавиша для вызова макроса.
 
xxx = jdecoder(Result)
 
Так как результат возвращает русский текст в юникоде, то нам необходимо его превратить в читабельный вид, для этого используется  написанная на коленке функция выполняющая эту задачу.
 
Далее идет не менее доморощенный разбор полученного русского ответа от сервера и получение только русского текста, исключая скобки, запятые, английские слова и прочее.
 
За это  у нас отвечает найденная на просторах интернета функция ClearName
 
И последнее, полученный результат, вставляется после после выделенного текста
то есть было 2/11/1014 а стало 2/11/1014(второе ноября одна тысяча четырнадцатого года)
  

Function jdecoder(TXT)

Str2 = TXT
Dim A
ReDim A(67)
Str1 = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя ё"
For i = 1 To Len(Str1)
A(i) = Mid$(Str1, i, 1)
Next
        For i = 1040 To 1105
            Str2 = Replace(Str2, "\u0" + LCase(Hex(i)), A(i - 1038))
        Next
 jdecoder = Str2
End Function
 
 
Как таковых, пояснений делать нет необходимости. Преобразовывает символы типа  \u0432 в русские символы.
 
 Макрос очистки текста, использующий регулярные выражения
 
Function ClearName(ByVal strText As String, ByVal strPattern As String) As String
    Dim RegExp As Object
    Set RegExp = CreateObject("vbscript.regexp")
    With RegExp
        .Pattern = strPattern
        .Global = True
        ClearName = .Replace(Trim(strText), "")
    End With
End Function
 
Если мы рассмотрим основной макрос то мы увидим что  функция ClearName(words(3), "[^а-я ]") говорит нам что из текста который храниться в переменной words(3) необходимо удалить все символы кроме русских от а до я.
 
Написанием нескольких десятков строк мы отвязались от необходимости  каждый раз  заходить на сайты онлайн конвертеров. Теперь у нас есть возможность непосредственно в Word или Excel преобразовывать дату(а при небольшой доработке не только дату но и сумму и время и просто число),  в пропись.  Это упрощает работу сотрудников которые часто работают с договорами и денежными документами.
 
Поиск по сайту