Преобразовать 123 в "сто двадцать три"

[Evgenyy]

Имеется число, например 123 ,(сумма по накладной)
необходимо отобразить его прописью, т.е. "сто двадцать три"
Язык VisualBasic
Как это сделать?

[A.A.Z.]

Код: Выделить всё

Function Сумма_прописью(s@) As String
Static triad(4) As Integer, numb1(0 To 19) As String, numb2(0 To 9) As String, numb3(0 To 9) As String
If s@ = 0 Then
Сумма_прописью = ""
Exit Function
End If
ss@ = s@
triad(1) = ss@ - Int(ss@ / 1000) * 1000
ss@ = Int(ss@ / 1000)
triad(2) = ss@ - Int(ss@ / 1000) * 1000
ss@ = Int(ss@ / 1000)
triad(3) = ss@ - Int(ss@ / 1000) * 1000
ss@ = Int(ss@ / 1000)
triad(4) = ss@ - Int(ss@ / 1000) * 1000
ss@ = Int(ss@ / 1000)
numb1(0) = ""
numb1(1) = "один "
numb1(2) = "два "
numb1(3) = "три "
numb1(4) = "четыре "
numb1(5) = "пять "
numb1(6) = "шесть "
numb1(7) = "семь "
numb1(8) = "восемь "
numb1(9) = "девять "
numb1(10) = "десять "
numb1(11) = "одиннадцать "
numb1(12) = "двенадцать "
numb1(13) = "тринадцать "
numb1(14) = "четырнадцать "
numb1(15) = "пятнадцать "
numb1(16) = "шестнадцать "
numb1(17) = "семнадцать "
numb1(18) = "восемнадцать "
numb1(19) = "девятнадцать "
numb2(0) = ""
numb2(1) = ""
numb2(2) = "двадцать "
numb2(3) = "тридцать "
numb2(4) = "сорок "
numb2(5) = "пятьдесят "
numb2(6) = "шестьдесят "
numb2(7) = "семьдесят "
numb2(8) = "восемьдесят "
numb2(9) = "девяносто "
numb3(0) = ""
numb3(1) = "сто "
numb3(2) = "двести "
numb3(3) = "триста "
numb3(4) = "четыреста "
numb3(5) = "пятьсот "
numb3(6) = "шестьсот "
numb3(7) = "семьсот "
numb3(8) = "восемьсот "
numb3(9) = "девятьсот "
txt$ = ""
If ss@ <> 0 Then
n% = MsgBox("Сумма выходит за границы формата", 16, "Сумма прописью")
Сумма_прописью = ""
Exit Function
End If
For i% = 4 To 1 Step -1
n% = 0
If triad(i%) > 0 Then
n% = Int(triad(i%) / 100)
txt$ = txt$ & numb3(n%)
n% = Int((triad(i%) - n% * 100) / 10)
txt$ = txt$ & numb2(n%)
If n% < 2 Then
n% = triad(i%) - (Int(triad(i%) / 10) - n%) * 10
Else
n% = triad(i%) - Int(triad(i%) / 10) * 10
End If
Select Case n%
Case 1
If i% = 2 Then txt$ = txt$ & "одна " Else txt$ = txt$ & "один "
Case 2
If i% = 2 Then txt$ = txt$ & "две " Else txt$ = txt$ & "два"
Case Else
txt$ = txt$ & numb1(n%)
End Select
Select Case i%
Case 2
If n% = 0 Or n% > 4 Then
txt$ = txt$ + "тысяч "
Else
If n% = 1 Then txt$ = txt$ + "тысяча " Else txt$ = txt$ + "тысячи "
End If
Case 3
If n% = 0 Or n% > 4 Then
txt$ = txt$ + "миллионов "
Else
If n% = 1 Then txt$ = txt$ + "миллион " Else txt$ = txt$ + "миллиона "
End If
Case 4
If n% = 0 Or n% > 4 Then
txt$ = txt$ + "миллиардов "
Else
If n% = 1 Then txt$ = txt$ + "миллиард " Else txt$ = txt$ + "миллиарда "
End If
End Select
End If
Next i%
txt$ = UCase$(Left$(txt$, 1)) & Mid$(txt$, 2)
Сумма_прописью = txt$
End Function


У кого стырил - не помню...

[SSecurity]

Вот 123 в "Сто двадцать три" - это в принцапи не сложно ... а вот попробуйте заставить программу реагировать на надпись так как должно быть а не так
100 20 3
есть конечно вариант сложит ... 100+20+3 = 123 ...
но предположим

Двенадцать тысяч честыресто двадцать пять = 12 1000 400 20 5 = 1437

Ну может попробовать при окончании Тысяч применять умножение на 1000, а при миллион на 1000000 ...

Так как быть?

[Alex_new_2030]

я делел для Excel. При вызове макроса открывается форма с 4мя textbox'ами и кнопкой. в текстбоксы вводишь координаты ячейки источника и ячейки с результатом.

Код: Выделить всё

Private Sub CommandButton3_Click()
Dim col1, row1, col2, row2 As Integer
'ячейка источник суммы
col1 = Val(TextBox2.Text)
row1 = Val(TextBox1.Text)
'ячейка для прописи суммы
col2 = Val(TextBox4.Text)
row2 = Val(TextBox3.Text)

Cells(row2, col2).Value = ""

summ$ = ""
Dim mil, tis, edin, tiyn As Integer, summa As Double
summa = Cells(row1, col1).Value
mil = Fix(summa / 1000000)
tis = Fix((summa - mil * 1000000) / 1000)
edin = Fix(summa - mil * 1000000 - tis * 1000)
tiyn = Fix((summa - Fix(summa)) * 100)
tiyns$ = Right$("00" & tiyn, 2)


mils$ = konv(mil) & pristavka_mil(mil)
tiss$ = konv(tis) & pristavka_tis(tis)
edins$ = konv(edin)

Cells(row2, col2).Value = mils$ & tiss$ & edins$ & "тенге " & tiyns$ & " тиын"
Unload Me
End Sub

Function pristavka_mil(chislo) As String
n3$ = Right$(Right$("00" & Str$(chislo), 3), 1)
n2$ = Mid$(Right$("00" & Str$(chislo), 3), 2, 1)
If chislo = 0 Then pristavka_mil = "": Exit Function
If n2$ = "1" Then
    s$ = "миллионов "
Else
    Select Case n3$
    Case "0", "5", "6", "7", "8", "9": s$ = "миллионов "
    Case "2", "3", "4": s$ = "миллиона "
    Case "1": s$ = "миллион "
    End Select
End If
pristavka_mil = s$
End Function


Function pristavka_tis(chislo) As String
n3$ = Right$(Right$("00" & Str$(chislo), 3), 1)
n2$ = Mid$(Right$("00" & Str$(chislo), 3), 2, 1)
If chislo = 0 Then pristavka_tis = "": Exit Function

If n2$ = "1" Then
    s$ = "тысяч "
Else
    Select Case n3$
    Case "0", "5", "6", "7", "8", "9": s$ = "тысяч "
    Case "2", "3", "4": s$ = "тысячи "
    Case "1": s$ = "тысяча "
    End Select
End If
pristavka_tis = s$
End Function


Function konv(chislo) As String
n1$ = Left$(Right$("00" & Str$(chislo), 3), 1)
n2$ = Mid$(Right$("00" & Str$(chislo), 3), 2, 1)
n3$ = Right$(Right$("00" & Str$(chislo), 3), 1)
Select Case n1$
Case "0": z$ = " "
Case "1": z$ = "сто "
Case "2": z$ = "двести "
Case "3": z$ = "триста "
Case "4": z$ = "четыреста "
Case "5": z$ = "пятьсот "
Case "6": z$ = "шестьсот "
Case "7": z$ = "семьсот "
Case "8": z$ = "восемьсот "
Case "9": z$ = "девятьсот "
End Select

Select Case n2$
Case "0": z$ = z$ & ""
Case "1"
    Select Case n3$
    Case "0": z$ = z$ & "десять "
    Case "1": z$ = z$ & "одиннадцать "
    Case "2": z$ = z$ & "двенадцать "
    Case "3": z$ = z$ & "тринадцать "
    Case "4": z$ = z$ & "четырнадцать "
    Case "5": z$ = z$ & "пятнадцать "
    Case "6": z$ = z$ & "шестнадцать "
    Case "7": z$ = z$ & "семнадцать "
    Case "8": z$ = z$ & "восемнадцать "
    Case "9": z$ = z$ & "девятнадцать "
    End Select
    GoTo konec



Case "2": z$ = z$ & "двадцать "
Case "3": z$ = z$ & "тридцать "
Case "4": z$ = z$ & "сорок  "
Case "5": z$ = z$ & "пятьдесят "
Case "6": z$ = z$ & "шестьдесят "
Case "7": z$ = z$ & "семьдесят "
Case "8": z$ = z$ & "восемьдесят "
Case "9": z$ = z$ & "девяносто "
End Select

Select Case n3$
Case "0":
If n1$ = "0" And n2$ = "0" Then z$ = z$ & "ноль " Else z$ = z$ & " "
Case "1": z$ = z$ & "один "
Case "2": z$ = z$ & "два "
Case "3": z$ = z$ & "три "
Case "4": z$ = z$ & "четыре  "
Case "5": z$ = z$ & "пять "
Case "6": z$ = z$ & "шесть "
Case "7": z$ = z$ & "семь "
Case "8": z$ = z$ & "восемь "
Case "9": z$ = z$ & "девять "
End Select


konec:

konv = z$

End Function


[SSecurity]

Есть у мня вариантик, могу Выложить

[GSerg]

Поздняк метаться
http://bbs.vbstreets.ru/viewtopic.php?p=21450#21450

[SSecurity]

У меня получилось нечто похожее..
но которое пишет окончания верно .. и тысячи и миллины пишет ... до миллиардов:)

Впринципе и дальше можно:) легко расширить:)