Неплохо, когда есть множество онлайн сервисов которые могу преобразовывать численное значение дат в пропись
Дата (день, месяц, год) прописью. Но все же у этих способов есть один неприятный недостаток. Например у вас есть много договоров в которые необходимо внести изменения следующего толка, вместо дат вида 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
Скажем лишь, что макрос за входные данные берет текст который был выделен и потом нажата горячая клавиша для вызова макроса.
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 преобразовывать дату(а при небольшой доработке не только дату но и сумму и время и просто число), в пропись. Это упрощает работу сотрудников которые часто работают с договорами и денежными документами.