Число процентов прописью

@ASSEI · Регистрация: 18.10.2012

Студворк — интернет-сервис помощи студентам

Ребята подскажите где можно посмотреть как в VB6 прописать прописью сумму в процентах с десятыми и с сотыми, например (Триста шестьдесят пять целых пятьдесят пять сотых процентов готовых)

@vice4 · 29.09.2017, 11:10

А если использовать функцию "пропись" для целых?

Например, есть число 125,57. Функция "пропись" переведет в пропись 125 - сто двадцать пять.
Далее, аналогично, 57 переводим в пятьдесят семь.
Дело за малым - написать слова "целых(ая)", "десятых(ая)", "сотых(ая)".

@Alex77755 · 03.10.2017, 10:14

или в функции сумма прописью заменить рублей на целых а копеек на сотых(десятых)

Добавлено через 47 минут

4.50 Четыре целых пятьдесят сотых процента
84,917.90 Восемьдесят четыре тысячи девятьсот семнадцать целых девяносто сотых процента

с десятыми лениво возиться. а так основа функции 'Автор MCH (Михаил Ч.)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Function MProzProp$(chislo#) 'Автор MCH (Михаил Ч.), май 2012
    Dim rub$, kop$, ed, des, sot, nadc, razr, i&, m$
    Dim mm
    If chislo >= 1E+15 Or chislo < 0 Then Exit Function
    
    sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
    des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
    nadc = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
    ed = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "", "одна ", "две ")
    razr = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "целая ", "целых ", "целых ")
    
    rub = Left(Format(chislo, "000000000000000.00"), 15)
    kop = Right(Format(chislo, "0.00"), 2)
    m = ""
    If CDbl(rub) = 0 Then m = "ноль "
    For i = 1 To Len(rub) Step 3
        If Mid(rub, i, 3) <> "000" Or i = Len(rub) - 2 Then
            m = m & sot(CInt(Mid(rub, i, 1))) & IIf(Mid(rub, i + 1, 1) = "1", nadc(CInt(Mid(rub, i + 2, 1))), _
                    des(CInt(Mid(rub, i + 1, 1))) & ed(CInt(Mid(rub, i + 2, 1)) + IIf(i = Len(rub) - 5 And CInt(Mid(rub, i + 2, 1)) < 3, 10, 0))) & _
                    IIf(Mid(rub, i + 1, 1) = "1" Or (Mid(rub, i + 2, 1) + 9) Mod 10 >= 4, razr(i + 1), IIf(Mid(rub, i + 2, 1) = "1", razr(i - 1), razr(i)))
        End If
    Next i
        
       If Mid(kop, i, 2) <> "00" Then
            mm = IIf(Mid(kop, 1, 1) = "1", nadc(CInt(Mid(kop, 1, 1))), des(CInt(Mid(kop, 1, 1))) & ed(CInt(Mid(kop, 2, 1))))
       End If
 
    MProzProp = UCase(Left(m, 1)) & Mid(m, 2) & mm & " сот" & IIf(kop \ 10 = 1 Or ((kop + 9) Mod 10) >= 4, "ых", IIf(kop Mod 10 = 1, "ая", "ых")) & " процента"
End Function

@ASSEI · 06.10.2017, 15:15 **[ТС]**

Простите за тупость, а что на кнопку то вешать?

Добавлено через 11 минут
извините все получилось, только один нюанс (0,9 - пишет Ноль целых девяносто сотых процента) но это ведь (девять десятых)

@ASSEI · 07.10.2017, 12:50 **[ТС]**

все таки у меня ни чего не получилось, прошу, помощи в данном вопросе.

@Gazzi · 07.10.2017, 21:41

Не знаю, как там проценты, а Рубли вот-так :

@Alex77755 · 08.10.2017, 12:39

ASSEI,
Просто скопируй код с сайта в модуль!

@Alex77755 · 08.10.2017, 12:43

В твоём проекте в модуле закомментированы 2 строки!
Думаешь они там лишние?

@ASSEI · 08.10.2017, 19:07 **[ТС]**

думаю да для того что мне требуется достаточно , в сущности требуется от 0,2%, 0,22, .... до 1,5%

Добавлено через 8 минут
вы правы ошибался! а что сделать с десятыми 0,9 (ноль целых девять десятых)

@Alex77755 · 09.10.2017, 01:12

Переделать функцию. Добавить условие проверки на 0 в конце и дописать код.
Или тупо в конце сделать подмены типа

Visual Basic
1
 MProzProp= Replace(MProzProp, "пятьдесят сотых","пять десятых")

и так для всех десятков

@ASSEI · 09.10.2017, 10:07 **[ТС]**

Нет, как ни говорите пока далеко до такого уровня, возможно как то в готовом виде? буду признателен вам за уделенное время.

@Alex77755 · 09.10.2017, 23:50

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Function MProzProp$(chislo#) 'Автор MCH (Михаил Ч.), май 2012
    Dim rub$, kop$, ed, des, sot, nadc, razr, i&, m$
    Dim mm
    Dim edd
 
    If chislo >= 1E+15 Or chislo < 0 Then Exit Function
    
    sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
    des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
    nadc = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
    ed = Array("", "один ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "", "одна ", "две ")
    edd = Array("", "однa ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "", "одна ", "две ")
    razr = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "целый ", "целых ", "целых ")
 
 
    
    rub = Left(Format(chislo, "000000000000000.00"), 15)
    kop = Right(Format(chislo, "0.00"), 2)
    m = ""
    If CDbl(rub) = 0 Then m = "ноль "
    For i = 1 To Len(rub) Step 3
        If Mid(rub, i, 3) <> "000" Or i = Len(rub) - 2 Then
            m = m & sot(CInt(Mid(rub, i, 1))) & IIf(Mid(rub, i + 1, 1) = "1", nadc(CInt(Mid(rub, i + 2, 1))), _
                    des(CInt(Mid(rub, i + 1, 1))) & ed(CInt(Mid(rub, i + 2, 1)) + IIf(i = Len(rub) - 5 And CInt(Mid(rub, i + 2, 1)) < 3, 10, 0))) & _
                    IIf(Mid(rub, i + 1, 1) = "1" Or (Mid(rub, i + 2, 1) + 9) Mod 10 >= 4, razr(i + 1), IIf(Mid(rub, i + 2, 1) = "1", razr(i - 1), razr(i)))
        End If
    Next i
 
    If Mid(kop, 2, 1) <> "0" Then
        mm = IIf(Mid(kop, 1, 1) = "1", nadc(CInt(Mid(kop, 2, 1))), des(CInt(Mid(kop, 1, 1))) & edd(CInt(Mid(kop, 2, 1))))
           MProzProp = UCase(Left(m, 1)) & Mid(m, 2) & mm & "сот" & IIf(kop \ 10 = 1 Or ((kop + 9) Mod 10) >= 4, "ых", IIf(kop Mod 10 = 1, "ая", "ых")) & " процента"
    Else
        mm = edd(CInt(Mid(kop, 1, 1)))
            MProzProp = UCase(Left(m, 1)) & Mid(m, 2) & mm & "десят" & IIf(kop = 10, "ая", "ых") & " процента"
    End If
End Function

@ASSEI · 10.10.2017, 09:36 **[ТС]**

Сообщение от Alex77755

mm = edd(CInt(Mid(kop, 1, 1)))

на строке ругается

@ASSEI · 10.10.2017, 09:42 **[ТС]**

извините не тот пример вложил

@Alex77755 · 10.10.2017, 13:43

Даже не буду искать ошибки! Проверял и вчера и только что - работат

@Alex77755 · 10.10.2017, 13:54

Научись пользоваться копипастом!!!

Добавлено через 2 минуты

В твоём проекте в модуле закомментированы 2 строки!
Думаешь они там лишние?

думаю да для того что мне требуется достаточно , в сущности требуется от 0,2%, 0,22, .... до 1,5%

Если думаешь, то не задавай глупых вопросов?
В твоём примере опять не все строки!!!

@ASSEI · 10.10.2017, 14:03 **[ТС]**

две ошибки я сам нашел, но есть еще недочеты, буду пытаться сам, ни чего не поделаешь.

@Alex77755 · 10.10.2017, 15:37

рабочий проект

@ASSEI · 11.10.2017, 09:03 **[ТС]**

сдается мне что то в этом проекте не хватат!

@Alex77755 · 11.10.2017, 22:50

Ага! Модуля

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .	SDL3 для Web (WebAssembly): Работа со звуком через SDL3_mixer 8Observer8 08.02.2026 Содержание блога Пошагово создадим проект для загрузки звукового файла и воспроизведения звука с помощью библиотеки SDL3_mixer. Звук будет воспроизводиться по клику мышки по холсту на Desktop и по. . .	SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств 8Observer8 07.02.2026 Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .
SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .

@ASSEI 0 / 1 / 3 Регистрация: 18.10.2012 Сообщений: 662

	Число процентов прописью 27.09.2017, 11:27. Показов 10580. Ответов 21 Метки нет (Все метки) Ребята подскажите где можно посмотреть как в VB6 прописать прописью сумму в процентах с десятыми и с сотыми, например (Триста шестьдесят пять целых пятьдесят пять сотых процентов готовых) 0

@vice4 28 / 28 / 4 Регистрация: 07.06.2017 Сообщений: 166
	29.09.2017, 11:10
	А если использовать функцию "пропись" для целых? Например, есть число 125,57. Функция "пропись" переведет в пропись 125 - сто двадцать пять. Далее, аналогично, 57 переводим в пятьдесят семь. Дело за малым - написать слова "целых(ая)", "десятых(ая)", "сотых(ая)". 0

@ASSEI 0 / 1 / 3 Регистрация: 18.10.2012 Сообщений: 662
	06.10.2017, 15:15 [ТС]
	Простите за тупость, а что на кнопку то вешать? Добавлено через 11 минут извините все получилось, только один нюанс (0,9 - пишет Ноль целых девяносто сотых процента) но это ведь (девять десятых) 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	08.10.2017, 12:39
	ASSEI, Просто скопируй код с сайта в модуль! Миниатюры 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	08.10.2017, 12:43
	В твоём проекте в модуле закомментированы 2 строки! Думаешь они там лишние? 0

@ASSEI 0 / 1 / 3 Регистрация: 18.10.2012 Сообщений: 662
	08.10.2017, 19:07 [ТС]
	думаю да для того что мне требуется достаточно , в сущности требуется от 0,2%, 0,22, .... до 1,5% Добавлено через 8 минут вы правы ошибался! а что сделать с десятыми 0,9 (ноль целых девять десятых) 0

@ASSEI 0 / 1 / 3 Регистрация: 18.10.2012 Сообщений: 662
	09.10.2017, 10:07 [ТС]
	Нет, как ни говорите пока далеко до такого уровня, возможно как то в готовом виде? буду признателен вам за уделенное время. 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	10.10.2017, 13:43
	Даже не буду искать ошибки! Проверял и вчера и только что - работат Миниатюры 0

@ASSEI 0 / 1 / 3 Регистрация: 18.10.2012 Сообщений: 662
	10.10.2017, 14:03 [ТС]
	две ошибки я сам нашел, но есть еще недочеты, буду пытаться сам, ни чего не поделаешь. 0

@ASSEI 0 / 1 / 3 Регистрация: 18.10.2012 Сообщений: 662
	11.10.2017, 09:03 [ТС]
	сдается мне что то в этом проекте не хватат! 0

Число процентов прописью

Решение