Страница: 1 |
Страница: 1 |
Вопрос: Вопрос????
Добавлено: 30.01.07 09:29
Автор вопроса: Konstantin
Вопрос????
Народ подскажите, можно ли в VBA прописать процедуру, которая писала бы числовое значение словами:
Пример 45 522-33 (сорок пять тысяч пятьсот двадцать два рубля 33 копейки)
Ответы
Всего ответов: 3
Номер ответа: 1
Автор ответа:
mc-black
ICQ: 308-534-060
Вопросов: 20
Ответов: 1860
Web-сайт:
Профиль | | #1
Добавлено: 30.01.07 10:17
можно
Public Function Propis(Summa As Double) As String
Dim t As String
Dim s() As String
Dim n(0 To 2) As Integer
Dim i As Integer
t = "один два три четыре пять шесть семь восемь девять десять одиннадцать двенадцать тринадцать четырнадцать пятнадцать шестнадцать семнадцать восемнадцать девятнадцать двадцать тридцать сорок пятьдесят шестьдесят семьдесят восемьдесят девяносто сто двести триста четыреста пятьсот шестьсот семьсот восемьсот девятьсот одна две тысяча тысячи тысяч евро цент цента центов ноль"
s = Split(t, " "
If Summa > 999999.99 Or Summa < 0 Then Exit Function
t = Trim(Format(Summa, "# ##0.00")
n(0) = CInt(Right$(t, 2))
t = Left$(t, InStr(1, t, "," - 1)
If InStr(1, t, " " = 0 Then
n(1) = CInt(t)
n(2) = 0
Else
n(1) = CInt(Mid$(t, InStr(1, t, " " + 1))
n(2) = CInt(Left$(t, InStr(1, t, " " - 1))
End If
t = ""
If n(2) > 0 Then
i = n(2) \ 100
If i > 0 Then
t = s(i + 26)
End If
i = n(2) - i * 100
If i > 0 Then
Select Case i
Case Is = 1
t = t & " " & s(36) & " " & s(38)
Case Is = 2
t = t & " " & s(37) & " " & s(39)
Case 3 To 4
t = t & " " & s(i - 1) & " " & s(39)
Case 5 To 19
t = t & " " & s(i - 1) & " " & s(40)
Case 20 To 99
t = t & " " & s(i \ 10 + 17)
i = i Mod 10
Select Case i
Case Is = 0
t = t & " " & s(40)
Case Is = 1
t = t & " " & s(36) & " " & s(38)
Case Is = 2
t = t & " " & s(37) & " " & s(39)
Case 3 To 4
t = t & " " & s(i - 1) & " " & s(39)
Case 5 To 9
t = t & " " & s(i - 1) & " " & s(40)
End Select
End Select
Else
t = t & " " & s(40)
End If
End If
If n(1) > 0 Then
i = n(1) \ 100
If i > 0 Then
t = t & " " & s(i + 26)
End If
i = n(1) - i * 100
If i > 0 Then
Select Case i
Case 1 To 19
t = t & " " & s(i - 1)
Case 20 To 99
t = t & " " & s(i \ 10 + 17)
i = i Mod 10
If i > 0 Then
t = t & " " & s(i - 1)
End If
End Select
End If
End If
t = t & " " & s(41) & " " & Format$(n(0), "00"
Select Case n(0)
Case Is = 0
t = t & " " & s(44)
Case Is = 1
t = t & " " & s(42)
Case 2 To 4
t = t & " " & s(43)
Case 5 To 19
t = t & " " & s(44)
Case 20 To 99
i = n(0) Mod 10
Select Case i
Case Is = 0
t = t & " " & s(44)
Case Is = 1
t = t & " " & s(42)
Case 2 To 4
t = t & " " & s(43)
Case 5 To 9
t = t & " " & s(44)
End Select
End Select
t = Trim(t)
If n(2) = 0 And n(1) = 0 Then t = s(45) & " " & t
t = UCase(Left(t, 1)) & Mid(t, 2)
Propis = t
End Function
это для евро. не претендую на идеальность алгоритма. в российскую валюту переделаешь сам (не забудь что получится выложить здесь). удачи!
Номер ответа: 2
Автор ответа:
mc-black
ICQ: 308-534-060
Вопросов: 20
Ответов: 1860
Web-сайт:
Профиль | | #2
Добавлено: 30.01.07 10:21
Можно и в формулах Excel использовать, и в других макросах.
=Propis(45522,33)
Сорок пять тысяч пятьсот двадцать два евро 33 цента
Номер ответа: 3
Автор ответа:
Konstantin
Вопросов: 7
Ответов: 12
Профиль | | #3
Добавлено: 30.01.07 12:00
Спасибо!
Как только свояю, результат обязательно выложу!