Я уже публиковал заметку о надстройке для Word - Дата прописью - позволяющей вставлять в документ или таблицу Excel различные даты прописью.

В этой заметке я приведу код макроса, с помощью которого можно легко вставить текущую дату прописью.

Этот макрос рассчитан на ближайшие два года, поэтому если текущий год в пользовательском компьютере не совпадает с заданными в макросе годами, то на экран будет выведено окно с соответствующим сообщением.

Sub insertDate()
'Вставка текущей даты прописью
Dim strNowDate As String
Dim strMyDay As String
Dim strMyMonth As String
Dim strMyYear As String
strNowDate = Format(Date, "dd mmmm yyyy")
Select Case Left(strNowDate, 2)
   Case Is = "01"
      strMyDay = "Первое"
   Case Is = "02"
      strMyDay = "Второе"
   Case Is = "03"
      strMyDay = "Третье"
   Case Is = "04"
      strMyDay = "Четвертое"
   Case Is = "05"
      strMyDay = "Пятое"
   Case Is = "06"
      strMyDay = "Шестое"
   Case Is = "07"
      strMyDay = "Седьмое"
   Case Is = "08"
      strMyDay = "Восьмое"
   Case Is = "09"
      strMyDay = "Девятое"
   Case Is = "10"
      strMyDay = "Десятое"
   Case Is = "11"
      strMyDay = "Одиннадцатое"
   Case Is = "12"
      strMyDay = "Двенадцатое"
   Case Is = "13"
      strMyDay = "Тринадцатое"
   Case Is = "14"
      strMyDay = "Четырнадцатое"
   Case Is = "15"
      strMyDay = "Пятнадцатое"
   Case Is = "16"
      strMyDay = "Шестнадцатое"
   Case Is = "17"
      strMyDay = "Семнадцатое"
   Case Is = "18"
      strMyDay = "Восемнадцатое"
   Case Is = "19"
      strMyDay = "Девятнадцатое"
   Case Is = "20"
      strMyDay = "Двадцатое"
   Case Is = "21"
      strMyDay = "Двадцать первое"
   Case Is = "22"
      strMyDay = "Двадцать второе"
   Case Is = "23"
      strMyDay = "Двадцать третье"
   Case Is = "24"
      strMyDay = "Двадцать четвертое"
   Case Is = "25"
      strMyDay = "Двадцать пятое"
   Case Is = "26"
      strMyDay = "Двадцать шестое"
   Case Is = "27"
      strMyDay = "Двадцать седьмое"
   Case Is = "28"
      strMyDay = "Двадцать восьмое"
   Case Is = "29"
      strMyDay = "Двадцать девятое"
   Case Is = "30"
      strMyDay = "Тридцатое"
   Case Is = "31"
      strMyDay = "Тридцать первое"
End Select
strMyMonth = Mid(strNowDate, 4, Len(strNowDate) - 8 )
Select Case Right(strNowDate, 4)
   Case Is = "2007"
      strMyYear = "две тысячи седьмого"
   Case Is = "2008"
      strMyYear = "две тысячи восьмого"
   Case Is = "2009"
      strMyYear = "две тысячи девятого"
   Case Else
      MsgBox prompt:="Текущий год не определен"
      Exit Sub
End Select
Selection.TypeText strMyDay & " " & strMyMonth & " " _
& strMyYear & " года"
End Sub

]]> ]]>