M
morpheus
Вопрос
Очень часто появляеться необходимость написать некоторые числа прописью (243=двести-сорок-три), как это зделать?
Ответ
[codebox]Dim NumEd (1 To 19) As String
Dim NumEd1(1 To 2) As String
Dim NumDec (2 To 9) As String
Dim NumSot (1 To 9) As String
Dim Xlion0 (1 To 3) As String
Dim Xlion1 (1 To 3) As String
Dim Xlion2 (1 To 3) As String
Class Money
Public Function MoneyToWord(Money As Double, valut As String, includekops As Boolean) As String
Select Case valut
Case "RUR":
NumArrayInitRUR
Case Else
valut = "RUR"
NumArrayInitRUR
End Select
Dim Money3 As Integer, MoneyI As Integer, MoneyK As Integer, Digit As Integer, LastDigit As Integer, T As Integer
Dim Sto As String, Kop As String, Result As String
MoneyI = Money
MoneyK = Round((Money - MoneyI) * 100, 0)
T = 0
While MoneyI > 0
Money3 = MoneyI Mod 1000
MoneyI = Int(MoneyI / 1000)
Sto = ""
If (Money3 Mod 100) < 20 Then
LastDigit = (Money3 Mod 20)
If LastDigit > 0 Then
If (T = 1) And (LastDigit =1 Or LastDigit =2) Then
Sto = NumEd1(LastDigit)
Else
Sto = NumEd(LastDigit)
End If
End If
Money3 = Int(Money3 /100)
Else
LastDigit = Money3 Mod 10
If LastDigit > 0 Then
If (T = 1) And (LastDigit =1 Or LastDigit =2) Then
Sto = NumEd1(LastDigit)
Else
Sto = NumEd(LastDigit)
End If
End If
Money3 = Int(Money3 / 10)
Digit = Money3 Mod 10
If Digit > 0 Then
Sto = NumDec(Digit) + Sto
End If
Money3 = Int(Money3 / 10)
End If
If Money3 > 0 Then
Sto = NumSot(Money3) + Sto
End If
If T > 0 Then
If LastDigit = 1 Then
Sto = Sto + Xlion1(T)
Else
If (LastDigit >= 2 And LastDigit<= 4) Then
Sto = Sto + Xlion2(T)
Else
Sto = Sto + Xlion0(T)
End If
End If
End If
T = T + 1
Result = Sto + Result
Wend
Kop =Cstr(MoneyK Mod 10)
MoneyK = MoneyK / 10
Kop = Cstr(MoneyK) + Kop
Select Case valut
Case "RUR":
If includekops Then
Result = Result + "руб. " + Kop + " коп."
Else
Result =Result + "руб. "
End If
End Select
MoneyToWord = result
End Function
Private Sub NumArrayInitRUR
NumEd(1) = "один "
NumEd(2) = "два "
NumEd(3) = "три "
NumEd(4) = "четыре "
NumEd(5) = "пять "
NumEd(6) = "шесть "
NumEd(7) = "семь "
NumEd(8) = "восемь "
NumEd(9) = "девять "
NumEd(10) = "десять "
NumEd(11) = "одиннадцать "
NumEd(12) = "двенадцать "
NumEd(13) = "тринадцать "
NumEd(14) = "четырнадцать "
NumEd(15) = "пятнадцать "
NumEd(16) = "шестадцать "
NumEd(17) = "семнадцать "
NumEd(18) = "восемнадцать "
NumEd(19) = "девятнадцать "
NumEd1(1) = "одна "
NumEd1(2) = "две "
NumDec (2) = "двадцать "
NumDec (3) = "тридцать "
NumDec (4) = "сорок "
NumDec (5) = "пятьдесят "
NumDec (6) = "шестьдесят "
NumDec (7) = "семьдесят "
NumDec (8) = "восемьдесят "
NumDec (9) = "девяносто "
NumSot(1) = "сто "
NumSot(2) = "двести "
NumSot(3) = "триста "
NumSot(4) = "четыреста "
NumSot(5) = "пятьсот "
NumSot(6) = "шестьсот "
NumSot(7) = "семьсот "
NumSot(8) = "восемьсот "
NumSot(9) = "девятьсот "
XLion0(1) = "тысяч "
XLion0(2) = "миллионов "
XLion0(3) = "миллиардов "
XLion1(1) = "тысяча "
XLion1(2) = "миллион "
XLion1(3) = "миллиард "
XLion2(1) = "тысячи "
XLion2(2) = "миллиона "
XLion2(3) = "миллиарда"
End Sub
End Class[/codebox]
Комментарий
Автор
link removed
Очень часто появляеться необходимость написать некоторые числа прописью (243=двести-сорок-три), как это зделать?
Ответ
Здравствуйте, господа! Столкнулся с проблемой: надо было сумму написать прописью. На нашем форуме ничего не нашёл. Переделал код, который взял с SQL.ru ну и примочек всяких добавил. Возможно кому-то пригодится:
[codebox]Dim NumEd (1 To 19) As String
Dim NumEd1(1 To 2) As String
Dim NumDec (2 To 9) As String
Dim NumSot (1 To 9) As String
Dim Xlion0 (1 To 3) As String
Dim Xlion1 (1 To 3) As String
Dim Xlion2 (1 To 3) As String
Class Money
Public Function MoneyToWord(Money As Double, valut As String, includekops As Boolean) As String
Select Case valut
Case "RUR":
NumArrayInitRUR
Case Else
valut = "RUR"
NumArrayInitRUR
End Select
Dim Money3 As Integer, MoneyI As Integer, MoneyK As Integer, Digit As Integer, LastDigit As Integer, T As Integer
Dim Sto As String, Kop As String, Result As String
MoneyI = Money
MoneyK = Round((Money - MoneyI) * 100, 0)
T = 0
While MoneyI > 0
Money3 = MoneyI Mod 1000
MoneyI = Int(MoneyI / 1000)
Sto = ""
If (Money3 Mod 100) < 20 Then
LastDigit = (Money3 Mod 20)
If LastDigit > 0 Then
If (T = 1) And (LastDigit =1 Or LastDigit =2) Then
Sto = NumEd1(LastDigit)
Else
Sto = NumEd(LastDigit)
End If
End If
Money3 = Int(Money3 /100)
Else
LastDigit = Money3 Mod 10
If LastDigit > 0 Then
If (T = 1) And (LastDigit =1 Or LastDigit =2) Then
Sto = NumEd1(LastDigit)
Else
Sto = NumEd(LastDigit)
End If
End If
Money3 = Int(Money3 / 10)
Digit = Money3 Mod 10
If Digit > 0 Then
Sto = NumDec(Digit) + Sto
End If
Money3 = Int(Money3 / 10)
End If
If Money3 > 0 Then
Sto = NumSot(Money3) + Sto
End If
If T > 0 Then
If LastDigit = 1 Then
Sto = Sto + Xlion1(T)
Else
If (LastDigit >= 2 And LastDigit<= 4) Then
Sto = Sto + Xlion2(T)
Else
Sto = Sto + Xlion0(T)
End If
End If
End If
T = T + 1
Result = Sto + Result
Wend
Kop =Cstr(MoneyK Mod 10)
MoneyK = MoneyK / 10
Kop = Cstr(MoneyK) + Kop
Select Case valut
Case "RUR":
If includekops Then
Result = Result + "руб. " + Kop + " коп."
Else
Result =Result + "руб. "
End If
End Select
MoneyToWord = result
End Function
Private Sub NumArrayInitRUR
NumEd(1) = "один "
NumEd(2) = "два "
NumEd(3) = "три "
NumEd(4) = "четыре "
NumEd(5) = "пять "
NumEd(6) = "шесть "
NumEd(7) = "семь "
NumEd(8) = "восемь "
NumEd(9) = "девять "
NumEd(10) = "десять "
NumEd(11) = "одиннадцать "
NumEd(12) = "двенадцать "
NumEd(13) = "тринадцать "
NumEd(14) = "четырнадцать "
NumEd(15) = "пятнадцать "
NumEd(16) = "шестадцать "
NumEd(17) = "семнадцать "
NumEd(18) = "восемнадцать "
NumEd(19) = "девятнадцать "
NumEd1(1) = "одна "
NumEd1(2) = "две "
NumDec (2) = "двадцать "
NumDec (3) = "тридцать "
NumDec (4) = "сорок "
NumDec (5) = "пятьдесят "
NumDec (6) = "шестьдесят "
NumDec (7) = "семьдесят "
NumDec (8) = "восемьдесят "
NumDec (9) = "девяносто "
NumSot(1) = "сто "
NumSot(2) = "двести "
NumSot(3) = "триста "
NumSot(4) = "четыреста "
NumSot(5) = "пятьсот "
NumSot(6) = "шестьсот "
NumSot(7) = "семьсот "
NumSot(8) = "восемьсот "
NumSot(9) = "девятьсот "
XLion0(1) = "тысяч "
XLion0(2) = "миллионов "
XLion0(3) = "миллиардов "
XLion1(1) = "тысяча "
XLion1(2) = "миллион "
XLion1(3) = "миллиард "
XLion2(1) = "тысячи "
XLion2(2) = "миллиона "
XLion2(3) = "миллиарда"
End Sub
End Class[/codebox]
Комментарий
Работает с рублями. Если написать процедуру инит для др валюты то будет с другой валютой работать. Прошу известить если найдете косячки или просто чего-то доработаете.
Параметр valut - наименование валюты по международной номенклатуре. includekops - добавлять или нет копейки к сумме.
Автор