Visual Basic

Вопрос

Написал свою функцию на VB, возвращающую число прописью для печати счета. Она работает нормально, но код достаточно корявый. Буду благодарен, если кто-нибудь покажет свою подобную функцию.

Ответ

Создай форму. На нее 2 текстовых поля — txtInput (число ввод) и txtOut (вывод) и 2 кнопки — cmdInput (перевести) и Command1 (выход) и вставь код:

Public Function Num3(trojka$, i%) Dim sl$(1 To 3, 0 To 3) sl$(1, 1) = "миллион " sl$(2, 1) = "тысяча " sl$(3, 1) = "рубль " '-------------------------------------- sl$(1, 2) = "миллиона " sl$(2, 2) = "тысячи " sl$(3, 2) = "рубля " '-------------------------------------- sl$(1, 3) = "миллионов " sl$(2, 3) = "тысяч " sl$(3, 3) = "рублей " sl$(3, 0) = "рублей " '-------------------------------------- ed$ = Right$(trojka$, 1) des$ = Mid$(trojka$, 2, 1) sot$ = Left$(trojka$, 1) '-------------------------------------- If ed$ = "0" Then r3$ = "" If ed$ = "1" Then If i% = 2 Then r3$ = "одна " Else r3$ = "один " If ed$ = "2" Then If i% = 2 Then r3$ = "две " Else r3$ = "два " If ed$ = "3" Then r3$ = "три " If ed$ = "4" Then r3$ = "четыре " If ed$ = "5" Then r3$ = "пять " If ed$ = "6" Then r3$ = "шесть " If ed$ = "7" Then r3$ = "семь " If ed$ = "8" Then r3$ = "восемь " If ed$ = "9" Then r3$ = "девять " '-------------------------------------- If des$ = "0" Then r2$ = "" s$ = des$ & ed$ If s$ = "10" Then r3$ = "десять " If s$ = "11" Then r3$ = "одиннадцать " If s$ = "12" Then r3$ = "двенадцать " If s$ = "13" Then r3$ = "тринадцать " If s$ = "14" Then r3$ = "четырнадцать " If s$ = "15" Then r3$ = "пятнадцать " If s$ = "16" Then r3$ = "шестнадцать " If s$ = "17" Then r3$ = "семнадцать " If s$ = "18" Then r3$ = "восемнадцать " If s$ = "19" Then r3$ = "девятнадцать " '-------------------------------------- If des$ = "2" Then r2$ = "двадцать " If des$ = "3" Then r2$ = "тридцать " If des$ = "4" Then r2$ = "сорок " If des$ = "5" Then r2$ = "пятьдесят " If des$ = "6" Then r2$ = "шестьдесят " If des$ = "7" Then r2$ = "семьдесят " If des$ = "8" Then r2$ = "восемьдесят " If des$ = "9" Then r2$ = "девяносто " '-------------------------------------- If sot$ = "0" Then r1$ = "" If sot$ = "1" Then r1$ = "сто " If sot$ = "2" Then r1$ = "двести " If sot$ = "3" Then r1$ = "триста " If sot$ = "4" Then r1$ = "четыреста " If sot$ = "5" Then r1$ = "пятьсот " If sot$ = "6" Then r1$ = "шестьсот " If sot$ = "7" Then r1$ = "семьсот " If sot$ = "8" Then r1$ = "восемьсот " If sot$ = "9" Then r1$ = "девятьсот " '-------------------------------------- If trojka$ <> "000" Then j% = (-1) * CInt(ed$ = "1" And des$ <> "1") _ + (-2) * CInt((ed$ = "2" Or ed$ = "3" Or ed$ = "4") And des$ <> "1") If j% = 0 And trojka$ <> "000" Then j% = 3 trojka$ = r1$ & r2$ & r3$ & sl$(i%, j%) 'формирование тройки цифр и 'слова,например-"123 тысячи" End Function '****************************************** Private Sub cmdinput_Click() w$ = txtinput.Text 'Входное число — текст типа "123.45",защита '"от дурака" не сделана 'выделение рублей в записи числа и удаление левых пробелов rubli$ = LTrim$(Left$(Str(Val(w$) * 100), _ Len(Str(Val(w$) * 100)) — 2)) cop$ = RTrim$(Right$(Str(Val(w$) * 100), 2)) 'выделение дробной части 'числа и удаление правых пробелов Do While Len(rubli$) < 9 rubli$ = "0" & rubli$ Loop res$ = "" For i% = 1 To 3 trojka$ = Mid$(rubli$, 3 * i% — 2, 3) Call Num3(trojka$, i%) ' Вызов функции формирования готовой тройки, 'типа "123 тысячи" res$ = res$ & trojka$ ' Накопление таких троек Next i% res$ = UCase$(Left$(res$, 1)) & Right$(res$, Len(res$) — 1) 'Запись 'первой буквы res$ в верхнем регистре c$ = " копеек" ' Блок добавления копеек If (Right$(cop$, 1) = "1" And Left$(cop$, 1) <> "1") Then c$ = _ " копейка" If ((Right$(cop$, 1) = "2" Or Right$(cop$, 1) = "3" Or _ Right$(cop$, 1) = "4") And Left$(cop$, 1) <> "1") Then _ c$ = " копейки" If Left(res$, 1) <> "Р" Then res$ = res$ & cop$ & c$ Else _ res$ = cop$ & c$ txtout.Text = res$ ' Выход текста End Sub Private Sub Command1_Click() End End Sub

@LEXis

Я когда-то нашла такую функцию кажется в базе данных ACCESS "Борей"

Function СуммаПрописью(СуммаСчета As Currency) As String ' Аргументы: Используются глобальные аргументы ' Сумма, Остаток и Подпись ' Назначение: Перевод СуммыСчета в строковую константу ' Возвращает: СуммуПрописью Dim Группа As Long, Разряд As Long, Длина As Integer Dim Пропись As String Сумма = СуммаСчета Остаток = Сумма Группа = Остаток \ 1000000 If Группа <> 0 Then Разряд = Группа \ 100 Пропись = Пропись & Сотни(Разряд) Остаток = Остаток — Разряд * 100 * 1000000 Группа = Группа — Разряд * 100 If Группа > 19 Then Разряд = Группа \ 10 Пропись = Пропись & Десятки(Разряд) Остаток = Остаток — Разряд * 10 * 1000000 Группа = Группа — Разряд * 10 End If Разряд = Группа Пропись = Пропись & Единицы(Разряд, "Мужской") Остаток = Остаток — Разряд * 1000000 Пропись = Пропись & Миллионы(Разряд) End If Группа = Остаток \ 1000 If Группа <> 0 Then Разряд = Группа \ 100 Пропись = Пропись & Сотни(Разряд) Остаток = Остаток — Разряд * 100 * 1000 Группа = Группа — Разряд * 100 If Группа > 19 Then Разряд = Группа \ 10 Пропись = Пропись & Десятки(Разряд) Остаток = Остаток — Разряд * 10 * 1000 Группа = Группа — Разряд * 10 End If Разряд = Группа Пропись = Пропись & Единицы(Разряд, "Женский") Остаток = Остаток — Разряд * 1000 Пропись = Пропись & Тысячи(Разряд) End If Группа = Остаток If Группа <> 0 Then Разряд = Группа \ 100 Пропись = Пропись & Сотни(Разряд) Остаток = Остаток — Разряд * 100 Группа = Группа — Разряд * 100 If Группа > 19 Then Разряд = Группа \ 10 Пропись = Пропись & Десятки(Разряд) Остаток = Остаток — Разряд * 10 Группа = Группа — Разряд * 10 End If Разряд = Группа Пропись = Пропись & Единицы(Разряд, "Мужской") Остаток = Остаток — Разряд Пропись = Пропись & Рубли(Разряд) End If Длина = Len(Пропись) If IsNull(Длина) Then Exit Function End If Пропись = UCase(Mid(Пропись, 1, 1)) & (Mid(Пропись, 2, Длина)) СуммаПрописью = Пропись End Function Function Тысячи(Разряд As Long) As String If Разряд = 1 Then Тысячи = "тысяча " ElseIf Разряд > 1 And Разряд < 5 Then Тысячи = "тысячи " Else Тысячи = "тысяч " End If End Function Function Миллионы(Разряд As Long) As String If Разряд = 1 Then Миллионы = "миллион " ElseIf Разряд > 1 And Разряд < 5 Then Миллионы = "миллиона " Else Миллионы = "миллионов " End If End Function Function Рубли(Разряд As Long) As String If Разряд = 1 Then Рубли = "рубль" ElseIf Разряд > 1 And Разряд < 5 Then Рубли = "рубля" Else Рубли = "рублей" End If End Function Function Сотни(Разряд As Long) As String Select Case Разряд Case 1 Сотни = "сто " Case 2 Сотни = "двести " Case 3 Сотни = "триста " Case 4 Сотни = "четыреста " Case 5 Сотни = "пятьсот " Case 6 Сотни = "шестьсот " Case 7 Сотни = "семьсот " Case 8 Сотни = "восемьсот " Case 9 Сотни = "девятьсот " End Select End Function Function Десятки(Разряд As Long) As String Select Case Разряд Case 2 Десятки = "двадцать " Case 3 Десятки = "тридцать " Case 4 Десятки = "сорок " Case 5 Десятки = "пятьдесят " Case 6 Десятки = "шестьдесят " Case 7 Десятки = "семьдесят " Case 8 Десятки = "восемьдесят " Case 9 Десятки = "девяносто " End Select End Function Function Единицы(Разряд As Long, Род As String) As String Select Case Разряд Case 1 If Род = "Мужской" Then Единицы = "один " Else Единицы = "одна " End If Case 2 If Род = "Мужской" Then Единицы = "два " Else Единицы = "две " End If Case 3 Единицы = "три " Case 4 Единицы = "четыре " Case 5 Единицы = "пять " Case 6 Единицы = "шесть " Case 7 Единицы = "семь " Case 8 Единицы = "восемь " Case 9 Единицы = "девять " Case 10 Единицы = "десять " Case 11 Единицы = "одиннадцать " Case 12 Единицы = "двенадцать " Case 13 Единицы = "тринадцать " Case 14 Единицы = "четырнадцать " Case 15 Единицы = "пятнадцать " Case 16 Единицы = "шестнадцать " Case 17 Единицы = "семнадцать " Case 18 Единицы = "восемнадцать " Case 19 Единицы = "девятнадцать " End Select End Function

Oksana Skripko