Visual Basic [требуется помощь]

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Gen1rus, 22 Dec 2010.

  1. Gen1rus

    Gen1rus Elder - Старейшина

    Joined:
    13 Jun 2007
    Messages:
    97
    Likes Received:
    164
    Reputations:
    20
    Нужно, чтобы числа писались прописью. Например пятьсот рублей копеек, а надо например чтобы пятьсот рублей тридцать копеек...
    Работа в экселе...

    Наброски такие (помогите дописать):
    PHP:
    Sub Кнопка1_Щелчок()

    End Sub

    Function Сумма_прописью(s As Currency) As String

    Dim triad    (4) As Integer
    Dim numb1    (0 To 19) As String
    Dim numb2    (0 To 9) As String
    Dim numb3    (0 To 9) As String
    Dim ss     As Currency
    Dim txt     As String
    Dim n     As Integer
    Dim i     As Integer
    Dim m     As Integer

    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

    If n = 0 Or n > 4 Then
    txt     = txt + "рублей "
    Else
    If     n = 1 Then txt = txt + "рубль " Else txt = txt + "рубля "
    End If

    If     m = 0 Or m > 4 Then
    txt     = txt + " копеек"
    Else
    If     m = 1 Then txt = txt + " копейка" Else txt = txt + " копейки"
    End If

    txt = UCase$(Left$(txt, 1)) & Mid$(txt, 2)
    Сумма_прописью = txt

    End     Function
     
    #1 Gen1rus, 22 Dec 2010
  2. A_n_d_r_e_i

    A_n_d_r_e_i Active Member

    Joined:
    2 Sep 2009
    Messages:
    175
    Likes Received:
    250
    Reputations:
    27
    в модуль:
    Code:
    Option Explicit

Function Сумма_прописью(s As Currency) As String

Dim triad(4) As Integer
Dim numb1(0 To 19) As String
Dim numb2(0 To 9) As String
Dim numb3(0 To 9) As String
Dim ss As Currency
Dim txt As String
Dim n As Integer
Dim i As Integer

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

If n = 0 Or n > 4 Then
txt = txt + "рублей"
Else
If n = 1 Then txt = txt + "рубль" Else txt = txt + "рубля"
End If

txt = UCase$(Left$(txt, 1)) & Mid$(txt, 2)
Сумма_прописью = txt

End Function

Private Sub Command1_Click()
Text1.Text = Сумма_прописью(Text1.Text)
End Sub
    гугл, это такой сайт, где есть всё, нужно только попытаться найти то, что тебе нужно
     
    #2 A_n_d_r_e_i, 22 Dec 2010
  3. Gen1rus

    Gen1rus Elder - Старейшина

    Joined:
    13 Jun 2007
    Messages:
    97
    Likes Received:
    164
    Reputations:
    20
    копейки не пишет :(
     
    #3 Gen1rus, 22 Dec 2010
  4. A_n_d_r_e_i

    A_n_d_r_e_i Active Member

    Joined:
    2 Sep 2009
    Messages:
    175
    Likes Received:
    250
    Reputations:
    27
    пробуй

    Code:
    Option Explicit

Function Сумма_прописью(s As Currency) As String

Dim triad(4) As Integer
Dim numb1(0 To 19) As String
Dim numb2(0 To 9) As String
Dim numb3(0 To 9) As String
Dim ss As Currency
Dim txt As String
Dim n As Integer
Dim i As Integer

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

If n = 0 Or n > 4 Then
txt = txt + "рублей"
Else
If n = 1 Then txt = txt + "рубль" Else txt = txt + "рубля"
End If
If n = 0 Or n > 4 Then
txt = txt + "копеек"
Else
If n = 1 Then txt = txt + "копейка" Else txt = txt + "копейки"
End If

txt = UCase$(Left$(txt, 1)) & Mid$(txt, 2)
Сумма_прописью = txt

End Function

Private Sub Command1_Click()
Text1.Text = Сумма_прописью(Text1.Text)
End Sub
     
    #4 A_n_d_r_e_i, 22 Dec 2010
  5. Gen1rus

    Gen1rus Elder - Старейшина

    Joined:
    13 Jun 2007
    Messages:
    97
    Likes Received:
    164
    Reputations:
    20
    неа... Не пишет всё равно копейки
     
    #5 Gen1rus, 22 Dec 2010
  6. A_n_d_r_e_i

    A_n_d_r_e_i Active Member

    Joined:
    2 Sep 2009
    Messages:
    175
    Likes Received:
    250
    Reputations:
    27
    ну скажи преподу мол это ж всё-равно копейки :D
    ну ладно, хз
     
    #6 A_n_d_r_e_i, 22 Dec 2010
(You must log in or sign up to post here.)