Макросы и функции VBA

Функция "Пропись даты"

Преобразует цифровую запись даты в прописное значение.

=ДАТА_ПРОПИСЬЮ(A1;1;1), где:

• Дата - ссылка на ячейку с датой;

• Падеж - "1" - именительный падеж, "2" - родительный падеж;

• Формат - "1" - все прописью, "2" - число и год цифрами.

Function ДАТА_ПРОПИСЬЮ(ByVal ДАТА As Date, Optional ByVal ПАДЕЖ As Integer = 1, Optional ByVal ФОРМАТ As Integer = 1) As String

    Dim L1000(9) As String
    Dim L100(9, 2) As String 'Сотни
    Dim L10(9, 2) As String 'Десятки
    Dim L1(22, 2) As String 'Единицы
    Dim m(12) As String 'Месяцы
    Dim SYM(3) As String

    Dim d As Integer, Y As Integer

    Dim LETTERS As String, LETTDAY As String, LETTMONTH As String, LETTYEAR As String
    Dim n1000 As Integer, n100 As Integer, n10 As Integer, n1 As Integer
    
    'Месяцы
    m(1) = "января"
    m(2) = "февраля"
    m(3) = "марта"
    m(4) = "апреля"
    m(5) = "мая"
    m(6) = "июня"
    m(7) = "июля"
    m(8) = "августа"
    m(9) = "сентября"
    m(10) = "октября"
    m(11) = "ноября"
    m(12) = "декабря"

    'Единицы
    L1(0, 1) = "": L1(0, 0) = "": L1(0, 2) = ""
    L1(1, 1) = "одна": L1(1, 0) = "первое": L1(1, 2) = "первого"
    L1(2, 1) = "две": L1(2, 0) = "второе": L1(2, 2) = "второго"
    L1(3, 1) = "три": L1(3, 0) = "третье": L1(3, 2) = "третьего"
    L1(4, 1) = "четыре": L1(4, 0) = "четвертое": L1(4, 2) = "четвертого"
    L1(5, 1) = "пять": L1(5, 0) = "пятое": L1(5, 2) = "пятого"
    L1(6, 1) = "шесть": L1(6, 0) = "шестое": L1(6, 2) = "шестого"
    L1(7, 1) = "семь": L1(7, 0) = "седьмое": L1(7, 2) = "седьмого"
    L1(8, 1) = "восемь": L1(8, 0) = "восьмое": L1(8, 2) = "восьмого"
    L1(9, 1) = "девять": L1(9, 0) = "девятое": L1(9, 2) = "девятого"
    L1(10, 1) = "десять": L1(10, 0) = "десятое": L1(10, 2) = "десятого"
    L1(11, 1) = "одиннадцать": L1(11, 0) = "одиннадцатое": L1(11, 2) = "одиннадцатого"
    L1(12, 1) = "двенадцать": L1(12, 0) = "двенадцатое": L1(12, 2) = "двенадцатого"
    L1(13, 1) = "тринадцать": L1(13, 0) = "тринадцатое": L1(13, 2) = "тринадцатого"
    L1(14, 1) = "четырнадцать": L1(14, 0) = "четырнадцатое": L1(14, 2) = "четырнадцатого"
    L1(15, 1) = "пятнадцать": L1(15, 0) = "пятнадцатое": L1(15, 2) = "пятнадцатого"
    L1(16, 1) = "шестнадцать": L1(16, 0) = "шестнадцатое": L1(16, 2) = "шестнадцатого"
    L1(17, 1) = "семнадцать": L1(17, 0) = "семнадцатое": L1(17, 2) = "семнадцатого"
    L1(18, 1) = "восемнадцать": L1(18, 0) = "восемнадцатое": L1(18, 2) = "восемнадцатого"
    L1(19, 1) = "девятнадцать": L1(19, 0) = "девятнадцатое": L1(19, 2) = "девятнадцатого"
    L1(20, 1) = "двадцать": L1(20, 0) = "двадцатое": L1(20, 2) = "двадцатого"

    'Десятки
    L10(0, 1) = "": L10(0, 2) = "": L10(0, 0) = ""
    L10(1, 1) = "десять": L10(1, 2) = "десятого": L10(1, 0) = "десятое"
    L10(2, 1) = "двадцать": L10(2, 2) = "двадцатого": L10(2, 0) = "двадцатое"
    L10(3, 1) = "тридцать": L10(3, 2) = "тридцатого": L10(3, 0) = "тридцатое"
    L10(4, 1) = "сорок": L10(4, 2) = "сорокового"
    L10(5, 1) = "пятьдесят": L10(5, 2) = "пятьдесятого"
    L10(6, 1) = "шестьдесят": L10(6, 2) = "шестьдесятого"
    L10(7, 1) = "семьдесят": L10(7, 2) = "семьдесятого"
    L10(8, 1) = "восемьдесят": L10(8, 2) = "восемьдесятого"
    L10(9, 1) = "девяносто": L10(9, 2) = "девяностого"

    'Сотни
    L100(0, 1) = "": L100(0, 2) = ""
    L100(1, 1) = "сто": L100(1, 2) = "сотого"
    L100(2, 1) = "двести": L100(2, 2) = "двухсотого"
    L100(3, 1) = "триста": L100(3, 2) = "трехсотого"
    L100(4, 1) = "четыреста": L100(4, 2) = "четырехсотого"
    L100(5, 1) = "пятьсот": L100(5, 2) = "пятисотого"
    L100(6, 1) = "шестьсот": L100(6, 2) = "шестисотого"
    L100(7, 1) = "семьсот": L100(7, 2) = "семисотого"
    L100(8, 1) = "восемьсот": L100(8, 2) = "восьмисотого"
    L100(9, 1) = "девятьсот": L100(9, 2) = "девятисотого"

    'Тысячи
    L1000(1) = "тысячного"
    L1000(2) = "двухтысячного"
    L1000(3) = "трехтысячного"
    L1000(4) = "четырехтысячного"
    L1000(5) = "пятитысячного"
    L1000(6) = "шеститысячного"
    L1000(7) = "семитысячного"
    L1000(8) = "восьмитысячного"
    L1000(9) = "девятитысячного"

    SYM(1) = "тысяча"
    SYM(2) = "тысячи"
    SYM(3) = "тысяч"

    d = Day(ДАТА)

    'Число
    If d Mod 10 = 0 Then
        LETTDAY = IIf(ПАДЕЖ = 1, L10(d / 10, 0), L10(d / 10, 2))
    Else

        If d <= 20 Then
            LETTDAY = IIf(ПАДЕЖ = 1, L1(d, 0), L1(d, 2))
        Else
            'Выделение десятков
            n10 = d \ 10
            'Выделение единиц
            n1 = d Mod 10

            LETTDAY = L10(n10, 1) & " " & IIf(ПАДЕЖ = 1, L1(n1, 0), L1(n1, 2))
        End If
    End If

    'Месяц
    LETTMONTH = m(Month(ДАТА))

    'Год
    Y = Year(ДАТА)
    n1000 = Fix(Y / 1000)
    n100 = Fix((Y - n1000 * 1000) / 100)
    n10 = Y - n1000 * 1000 - n100 * 100
    n1 = n10 - Fix(n10 / 10) * 10

    If n1000 > 0 And n100 = 0 And n10 = 0 And n1 = 0 Then
        LETTYEAR = Trim(LETTYEAR & " " & L1000(n1000))
    ElseIf n1000 > 0 Then
        LETTYEAR = Trim(LETTYEAR & " " & L1(n1000, 1))
        If n1000 = 1 Then
            LETTYEAR = LETTYEAR & " " & SYM(1)
        ElseIf n1000 < 5 Then
            LETTYEAR = LETTYEAR & " " & SYM(2)
        Else
            LETTYEAR = LETTYEAR & " " & SYM(3)
        End If
    End If

    If n100 > 0 And n10 = 0 And n1 = 0 Then
        LETTYEAR = Trim(LETTYEAR & " " & L100(n100, 2))
    ElseIf n100 > 0 Then
        LETTYEAR = Trim(LETTYEAR & " " & L100(n100, 1))
    End If

    If n10 > 0 And n1 = 0 Then
        LETTYEAR = Trim(LETTYEAR & " " & L10(n10 / 10, 2))
    ElseIf n10 < 20 Then
        LETTYEAR = Trim(LETTYEAR & " " & L1(n10, 2))
    Else
        LETTYEAR = Trim(LETTYEAR & " " & L10(Fix(n10 / 10), 1) & " " & L1(n1, 2))
    End If

    Select Case ФОРМАТ
        Case 1
            LETTERS = LETTDAY & " " & LETTMONTH & " " & LETTYEAR & " года"
        Case 2
            LETTERS = Format(d, "00") & " " & LETTMONTH & " " & Format(Y, "#####") & " года"
        Case 3
            LETTERS = UCase(Left(LETTDAY, 1)) & Mid(LETTDAY, 2) & " " & LETTMONTH & " " & LETTYEAR & " года"
    End Select

    ДАТА_ПРОПИСЬЮ = LETTERS

End Function