1 1 1 1 1 1 1 1 1 1 Рейтинг 0.00 (0 голосов)

Дата прописью в VBA (Visual Basic for Application)

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

Макрос декодирования Unicode текста в VBA

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