powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
7 сообщений из 7, страница 1 из 1
Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
    #33192554
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Помогите пожалуйста избавиться от "рублей и копеек"
Нужно только описание цифр, (пример: 345 - тристо сорок пять)


Function ПРОПИСЬЮ(SourceDigits As Currency) As String
Dim STRNG As String, CHAR, Result As String, Prom As String
Dim i, STRNG_len As Long
Dim SourceDigTail As Currency

SourceDigTail = (SourceDigits - Int(SourceDigits)) * 100
SourceDigits = Int(SourceDigits)

STRNG = SourceDigits
STRNG_len = Len(STRNG)
For i = 1 To 9 - STRNG_len Step 1
STRNG = "0" & STRNG
Next i

For i = 9 To 9 - STRNG_len + 1 Step -1
CHAR = Mid(STRNG, i, 1)
If CHAR = "" Then GoTo end_c

If i = 2 Or i = 5 Or i = 8 Then
If CHAR = "1" Then
CHAR = Mid(STRNG, i, 2)
Select Case CHAR
Case "10"
Prom = "десять "
Case "11"
Prom = "одиннадцать "
Case "12"
Prom = "двенадцать "
Case "13"
Prom = "тринадцать "
Case "14"
Prom = "четырнадцать "
Case "15"
Prom = "пятнадцать "
Case "16"
Prom = "шестнадцать "
Case "17"
Prom = "семьнадцать "
Case "18"
Prom = "восемьнадцать "
Case "19"
Prom = "девятнадцать "
End Select
Else ' If char Not = 1
Select Case CHAR
Case "0"
Prom = ""
Case "2"
Prom = "двадцать "
Case "3"
Prom = "тридцать "
Case "4"
Prom = "сорок "
Case "5"
Prom = "пятьдесят "
Case "6"
Prom = "шестьдесят "
Case "7"
Prom = "семьдесят "
Case "8"
Prom = "восемьдесят "
Case "9"
Prom = "девяносто "
End Select
End If
End If
If i = 1 Or i = 4 Or i = 7 Then
Select Case CHAR
Case "0"
Prom = ""
Case "1"
Prom = "сто "
Case "2"
Prom = "двести "
Case "3"
Prom = "триста "
Case "4"
Prom = "четыреста "
Case "5"
Prom = "пятьсот "
Case "6"
Prom = "шестьсот "
Case "7"
Prom = "семьсот "
Case "8"
Prom = "восемьсот "
Case "9"
Prom = "девятьсот "
End Select
End If

If i = 3 Or i = 6 Or i = 9 Then

If i = 9 And Mid(STRNG, i - 1, 1) = "1" Then
Result = "рублей " & Result
GoTo end_c
End If

If i = 3 And Mid(STRNG, i - 1, 1) = "1" Then
Result = "миллионов " & Result
GoTo end_c
End If

If i = 6 And Mid(STRNG, i - 1, 1) = "1" Then
Result = "тысяч " & Result
GoTo end_c
End If

Select Case CHAR
Case "0"
Prom = ""
Case "1"
If i = 6 Then
Prom = "одна "
Else
Prom = "один "
End If
Case "2"
If i = 6 Then
Prom = "две "
Else
Prom = "два "
End If
Case "3"
Prom = "три "
Case "4"
Prom = "четыре "
Case "5"
Prom = "пять "
Case "6"
Prom = "шесть "
Case "7"
Prom = "семь "
Case "8"
Prom = "восемь "
Case "9"
Prom = "девять "
End Select
End If
Select Case i

Case 3
Select Case CHAR
Case "1"
Result = "миллион " & Result
Case "2", "3", "4"
Result = "миллиона " & Result
Case "5", "6", "7", "8", "9"
Result = "миллионов " & Result
Case "0"
If STRNG_len > 6 Then
Result = "миллионов " & Result
End If
End Select

Case 6
Select Case CHAR
Case "1"
Result = "тысячa " & Result
Case "2", "3", "4"
Result = "тысячи " & Result
Case "5", "6", "7", "8", "9"
Result = "тысяч " & Result
Case "0"
If STRNG_len > 3 Then
Result = "тысяч " & Result
End If
End Select

Case 9
Select Case CHAR
Case "1"
Result = "рубль " & Result
Case "2", "3", "4"
Result = "рубля " & Result
Case "0", "5", "6", "7", "8", "9"
Result = "рублей " & Result
End Select
End Select

Result = Prom & Result


end_c:
Next i

Result = Format(Mid(Result, 1, 1), ">") & Mid(Result, 2)

ПРОПИСЬЮ = Result & Format(SourceDigTail, "00") & " коп."

End Function
...
Рейтинг: 0 / 0
Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
    #33192582
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
не используй русские буквы в названии ф-ций.
Код: plaintext
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.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
Public Function propis(SourceDigits As Currency) As String
 Dim STRNG As String, CHAR, Result As String, Prom As String
 Dim i, STRNG_len As Long
 Dim SourceDigTail As Currency
 
 SourceDigTail = (SourceDigits - Int(SourceDigits)) *  100 
 SourceDigits = Int(SourceDigits)

 STRNG = SourceDigits
 STRNG_len = Len(STRNG)
  For i =  1  To  9  - STRNG_len Step  1 
   STRNG = "0" & STRNG
  Next i
  
  For i =  9  To  9  - STRNG_len +  1  Step - 1 
      CHAR = Mid(STRNG, i,  1 )
      If CHAR = "" Then GoTo end_c
   
   If i =  2  Or i =  5  Or i =  8  Then
      If CHAR = "1" Then
       CHAR = Mid(STRNG, i,  2 )
       Select Case CHAR
        Case "10"
          Prom = "десять "
        Case "11"
          Prom = "одиннадцать "
        Case "12"
          Prom = "двенадцать "
        Case "13"
          Prom = "тринадцать "
        Case "14"
          Prom = "четырнадцать "
        Case "15"
          Prom = "пятнадцать "
        Case "16"
          Prom = "шестнадцать "
        Case "17"
          Prom = "семьнадцать "
        Case "18"
          Prom = "восемьнадцать "
        Case "19"
          Prom = "девятнадцать "
      End Select
       Else  ' If char Not = 1
       Select Case CHAR
        Case "0"
          Prom = ""
        Case "2"
          Prom = "двадцать "
        Case "3"
          Prom = "тридцать "
        Case "4"
          Prom = "сорок "
        Case "5"
          Prom = "пятьдесят "
        Case "6"
          Prom = "шестьдесят "
        Case "7"
          Prom = "семьдесят "
        Case "8"
          Prom = "восемьдесят "
        Case "9"
          Prom = "девяносто "
       End Select
      End If
      End If
       If i =  1  Or i =  4  Or i =  7  Then
         Select Case CHAR
         Case "0"
          Prom = ""
         Case "1"
          Prom = "сто "
         Case "2"
          Prom = "двести "
         Case "3"
          Prom = "триста "
         Case "4"
          Prom = "четыреста "
         Case "5"
          Prom = "пятьсот "
         Case "6"
          Prom = "шестьсот "
         Case "7"
          Prom = "семьсот "
         Case "8"
          Prom = "восемьсот "
         Case "9"
          Prom = "девятьсот "
     End Select
     End If
     
     If i =  3  Or i =  6  Or i =  9  Then
         
              
         If i =  3  And Mid(STRNG, i -  1 ,  1 ) = "1" Then
          Result = "миллионов " & Result
          GoTo end_c
         End If
         
         If i =  6  And Mid(STRNG, i -  1 ,  1 ) = "1" Then
          Result = "тысяч " & Result
          GoTo end_c
         End If
         
         Select Case CHAR
         Case "0"
          Prom = ""
         Case "1"
            If i =  6  Then
               Prom = "одна "
             Else
               Prom = "один "
            End If
         Case "2"
            If i =  6  Then
               Prom = "две "
             Else
               Prom = "два "
            End If
        Case "3"
          Prom = "три "
         Case "4"
          Prom = "четыре "
         Case "5"
          Prom = "пять "
         Case "6"
          Prom = "шесть "
         Case "7"
          Prom = "семь "
         Case "8"
          Prom = "восемь "
         Case "9"
          Prom = "девять "
     End Select
     End If
     Select Case i
      
      Case  3 
       Select Case CHAR
        Case "1"
         Result = "миллион " & Result
        Case "2", "3", "4"
         Result = "миллиона " & Result
        Case "5", "6", "7", "8", "9"
         Result = "миллионов " & Result
        Case "0"
         If STRNG_len >  6  Then
          Result = "миллионов " & Result
         End If
       End Select
      
      Case  6 
        Select Case CHAR
         Case "1"
           Result = "тысячa " & Result
         Case "2", "3", "4"
           Result = "тысячи " & Result
         Case "5", "6", "7", "8", "9"
           Result = "тысяч " & Result
         Case "0"
           If STRNG_len >  3  Then
            Result = "тысяч " & Result
           End If
        End Select
            
     End Select
     
     Result = Prom & Result
     

end_c:
   Next i

    Result = Format(Mid(Result,  1 ,  1 ), ">") & Mid(Result,  2 )
    
propis = Result & Format(SourceDigTail, "00")

End Function
...
Рейтинг: 0 / 0
Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
    #33192672
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
big-duke спасибо, но работает с небольшой проблемой.
Во первых числа с 11 до 19 пишет в два слова (пример: 11 одинадцать один), Во вторых два ноля в конце тоже не особо нужны.
...
Рейтинг: 0 / 0
Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
    #33192706
Фотография SmeL_md
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
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.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
Function IntTxt(Number As Long) As String
Dim Z As String, tmp As String
Dim I As Integer, P As Integer, N As Integer, V As Integer
If Number =  0  Then
    IntTxt = "ноль"
Exit Function
End If
    Z = Trim$(Str$(Number))
    N = Fix((Len(Z) -  1 ) /  3 )
ReDim D( 0  To N) As Integer
    For I = Len(Z) To  1  Step - 1 
        P = Fix((Len(Z) - I) /  3 )
        tmp = Mid$(Z, I,  1 ) + tmp
        D(P) = Val(tmp)
            If Len(tmp) =  3  Then tmp = ""
    Next I
Z = ""
    For I = N To  0  Step - 1 
V = D(I)
P = Int(V /  100 )
Select Case P
Case  0 
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
 P = V -  100  * Int(V /  100 )

  Select Case Int(P /  10 )
    Case  0 
    Case  1 
    Select Case P -  10  * Int(P /  10 )
        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
      If (P -  10  * Int(P /  10 )) <>  0  Then
        Z = Z + "надцать "
        GoTo label
      End If
    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

If (Int(P /  100 )) <>  1  Then
    Select Case P -  10  * Int(P /  10 )
     Case  0 
     Case  1 
    Select Case I
          Case  1 
 Z = Z + "одна "
          Case Else
 Z = Z + "один "
        End Select
      Case  2 
        Select Case I
        Case  1 
 Z = Z + "две "
        Case Else
 Z = Z + "два "
        End Select
    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
End If
label:
Select Case I
    Case  0 
 tmp = ""
    Case  1 
 tmp = DTxt(V, "тысяча", "тысячи", "тысяч")
    Case  2 
 tmp = DTxt(V, "миллион", "миллиона", "миллионов")
    Case  3 
 tmp = DTxt(V, "миллиард", "миллиарда", "миллиардов")
    Case Else
 tmp = "#"
End Select
    If I >  0  Then Z = Z + tmp + " "
Next I
IntTxt = Z
End Function

Function DTxt(Number As Variant, W0 As String, W1 As String, W2 As String) As String
Dim tmp As String, Z As Integer
tmp = Trim$(Str$(Number))
Z = Val(Right$(tmp,  2 ))

If Z =  20  Then
    Select Case Z
      Case  0 ,  5  To  19 
        tmp = W2
      Case  1 
        tmp = W0
      Case  2 ,  3 ,  4 
        tmp = W1
    End Select
  Else
    Select Case (Z -  10  * Int(Z /  10 ))
      Case  0 ,  5  To  9 
        tmp = W2
      Case  1 
        tmp = W0
      Case  2 ,  3 ,  4 
        tmp = W1
    End Select
End If
DTxt = tmp
End Function

Function LetterSum(sum As Currency) As String
Dim R As Long, K As Integer, tmp As Integer
Dim Z As String, ZR As String, ZK As String
Const RKdiv = " "
R = Int(sum)
K = (sum - R) *  100 
ZR = IntTxt(R)
Z = ZR
Z = UCase$(Mid$(Z,  1 ,  1 )) + Mid$(Z,  2 )
LetterSum = Z
End Function

Private Sub Form_Load()
    MsgBox "[112581,23]=>" & LetterSum("112581,23")
End Sub
...
Рейтинг: 0 / 0
Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
    #33192797
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
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.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
Public Function Propis(SourceDigits As Long) As String
    Dim STRNG As String, CHAR, Result As String, Prom As String
    Dim i, STRNG_len As Long


    STRNG = SourceDigits
    STRNG_len = Len(STRNG)
    For i =  1  To  9  - STRNG_len Step  1 
        STRNG = "0" & STRNG
    Next i

    For i =  9  To  9  - STRNG_len +  1  Step - 1 
    CHAR = Mid(STRNG, i,  1 )
    If CHAR = "" Then GoTo end_c

    If i =  2  Or i =  5  Or i =  8  Then
        If CHAR = "1" Then
            CHAR = Mid(STRNG, i,  2 )
            Select Case CHAR
                Case "10"
                    Prom = "десять "
                Case "11"
                    Prom = "одиннадцать "
                Case "12"
                    Prom = "двенадцать "
                Case "13"
                    Prom = "тринадцать "
                Case "14"
                    Prom = "четырнадцать "
                Case "15"
                    Prom = "пятнадцать "
                Case "16"
                    Prom = "шестнадцать "
                Case "17"
                    Prom = "семьнадцать "
                Case "18"
                    Prom = "восемьнадцать "
                Case "19"
                    Prom = "девятнадцать "
            End Select
        Else
            Select Case CHAR
                Case "0"
                    Prom = ""
                Case "2"
                    Prom = "двадцать "
                Case "3"
                    Prom = "тридцать "
                Case "4"
                    Prom = "сорок "
                Case "5"
                    Prom = "пятьдесят "
                Case "6"
                    Prom = "шестьдесят "
                Case "7"
                    Prom = "семьдесят "
                Case "8"
                    Prom = "восемьдесят "
                Case "9"
                    Prom = "девяносто "
            End Select
        End If
    End If
    If i =  1  Or i =  4  Or i =  7  Then
        Select Case CHAR
            Case "0"
                Prom = ""
            Case "1"
                Prom = "сто "
            Case "2"
                Prom = "двести "
            Case "3"
                Prom = "триста "
            Case "4"
                Prom = "четыреста "
            Case "5"
                Prom = "пятьсот "
            Case "6"
                Prom = "шестьсот "
            Case "7"
                Prom = "семьсот "
            Case "8"
                Prom = "восемьсот "
            Case "9"
                Prom = "девятьсот "
        End Select
    End If

    If i =  3  Or i =  6  Or i =  9  Then
        If i =  3  And Mid(STRNG, i -  1 ,  1 ) = "1" Then
            Result = "миллионов " & Result
            GoTo end_c
        End If

        If i =  6  And Mid(STRNG, i -  1 ,  1 ) = "1" Then
            Result = "тысяч " & Result
            GoTo end_c
        End If

        Select Case CHAR
            Case "0"
                Prom = ""
                Case "1"
                    If i =  6  Then
                        Prom = "одна "
                    Else
                        Prom = "один "
                    End If
                Case "2"
                    If i =  6  Then
                        Prom = "две "
                    Else
                        Prom = "два "
                    End If
                Case "3"
                    Prom = "три "
                Case "4"
                    Prom = "четыре "
                Case "5"
                    Prom = "пять "
                Case "6"
                    Prom = "шесть "
                Case "7"
                    Prom = "семь "
                Case "8"
                    Prom = "восемь "
                Case "9"
                    Prom = "девять "
            End Select
    End If
    Select Case i
        Case  3 
            Select Case CHAR
                Case "1"
                    Result = "миллион " & Result
                Case "2", "3", "4"
                    Result = "миллиона " & Result
                Case "5", "6", "7", "8", "9"
                    Result = "миллионов " & Result
                Case "0"
                    If STRNG_len >  6  Then
                        Result = "миллионов " & Result
                    End If
            End Select
        Case  6 
            Select Case CHAR
                Case "1"
                    Result = "тысячa " & Result
                Case "2", "3", "4"
                    Result = "тысячи " & Result
                Case "5", "6", "7", "8", "9"
                    Result = "тысяч " & Result
                Case "0"
                    If STRNG_len >  3  Then
                        Result = "тысяч " & Result
                    End If
            End Select
    End Select

    Result = Prom & Result

end_c:
Next i

    
    

    Propis = Format(Mid(Result,  1 ,  1 ), ">") & Mid(Result,  2 )
    

End Function
...
Рейтинг: 0 / 0
Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
    #33192798
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
зы
А ваще по большому счету надо взять прогу DKMS(это ее автор) и выложить ее в фак.Я ей уже года два пользуюсь, заточил по евро и род безденежный формат. в общем вещь дельная. а то млин продолжаем изобретение мопеда.
тоак вот не знаю куда положить ? в васик или офис ?
вот это чудо
а общем the best тем более что автор не против ее модификации и т.д.
...
Рейтинг: 0 / 0
Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
    #33193118
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо!, все работает
...
Рейтинг: 0 / 0
7 сообщений из 7, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Visual Basic Цифры - прописью, Помогите избавиться от "рублей"
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]