VBA помощь!


  1. vkontakte
  2. mail
  1. saiberpro
    Более чем богоподобный

    Оффлайн
    -11

    Сообщений: 1036

    Симпатий: 86

    Трофеев: 17

    Собственно нужна помощь.Как удалить из печати на экран 0 в конце каждого вывода?.
    Собственно код:
    Function Propis(Amount As String, Optional Money As String = "RUB", Optional lang As String = "RU", Optional Prec As Integer = 1)
     Dim whole As Double
      
     Amount = Replace(Amount, "-", Application.International(xlDecimalSeparator))
     Amount = Replace(Amount, ".", Application.International(xlDecimalSeparator))
     Amount = Replace(Amount, ",", Application.International(xlDecimalSeparator))
      
     Sum = WorksheetFunction.Round(CDbl(Amount), 2)
     Money = UCase(Money)
     lang = UCase(lang)
     whole = Int(Sum)
     fraq = Format(Round((Sum - whole) * 100), "")
      
     Select Case Class(whole, 1) + Class(whole, 2) * 10
     Case 1, 21, 31, 41, 51, 61, 71, 81, 91
     w_rus_r = ""
     w_rus_d = "äîëëàð"
     w_rus_e = "åâðî"
     w_en_r = "rubles"
     w_en_d = "dollars"
     w_en_e = "euro"
     
     Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94
     w_rus_r = ""
     w_rus_d = "äîëëàðà"
     w_rus_e = "åâðî"
     w_en_r = "rubles"
     w_en_d = "dollars"
     w_en_e = "euro"
     
     Case Else
     w_rus_r = ""
     w_rus_d = "äîëëàðîâ"
     w_rus_e = "åâðî"
     w_en_r = "rubles"
     w_en_d = "dollars"
     w_en_e = "euro"
     
     End Select
     
     Select Case fraq
     Case 1, 21, 31, 41, 51, 61, 71, 81, 91
     f_rus_r = ""
     f_rus_d = "öåíò"
     f_rus_e = "öåíò"
     f_rus_p = "ñîòàÿ"
     f_en_r = "kopecks"
     f_en_d = "cents"
     f_en_e = "cents"
     f_en_e = "cents"
     
     Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94
     f_rus_r = ""
     f_rus_d = "öåíòà"
     f_rus_e = "öåíòà"
     f_en_r = "kopecks"
     f_en_d = "cents"
     f_en_e = "cents"
     Case Else
     f_rus_r = ""
     f_rus_d = "öåíòîâ"
     f_rus_e = "öåíòîâ"
     f_en_r = "kopecks"
     f_en_d = "cents"
     f_en_e = "cents"
     End Select
     
     If Prec = 0 Then
     fraq = ""
     f_rus_r = ""
     f_rus_d = ""
     f_rus_e = ""
     f_en_r = ""
     f_en_d = ""
     f_en_e = ""
     End If
      
     If lang = "RU" Then
     Select Case Money
     Case "RUB"
     Out = ScriptRus(whole) & " " & w_rus_r & " " & fraq & " " & f_rus_r
     Case "USD"
     Out = ScriptRus(whole) & " " & w_rus_d & " " & fraq & " " & f_rus_d
     Case "EUR"
     Out = ScriptRus(whole) & " " & w_rus_e & " " & fraq & " " & f_rus_e
     End Select
     End If
     
     If lang = "EN" Then
     Select Case Money
     Case "RUB"
     Out = ScriptEng(whole) & " " & w_en_r & " " & fraq & " " & f_en_r
     Case "USD"
     Out = ScriptEng(whole) & " " & w_en_d & " " & fraq & " " & f_en_d
     Case "EUR"
     Out = ScriptEng(whole) & " " & w_en_e & " " & fraq & " " & f_en_e
     End Select
     End If
     
     Propis = WorksheetFunction.Trim(Out)
     
    End Function
     
     
    Private Function Class(m, i)
     Class = Int(Int(m - (10 ^ i) * Int(m / (10 ^ i))) / 10 ^ (i - 1))
    End Function
     
    Private Function ScriptRus(n As Double) As String
     Dim Nums1, Nums2, Nums3, Nums4 As Variant
     Nums1 = Array("", "îäèí ", "äâà ", "òðè ", "÷åòûðå ", "ïÿòü ", "øåñòü ", "ñåìü ", "âîñåìü ", "äåâÿòü ")
     Nums2 = Array("", "äåñÿòü ", "äâàäöàòü ", "òðèäöàòü ", "ñîðîê ", "ïÿòüäåñÿò ", "øåñòüäåñÿò ", "ñåìüäåñÿò ", "âîñåìüäåñÿò ", "äåâÿíîñòî ")
     Nums3 = Array("", "ñòî ", "äâåñòè ", "òðèñòà ", "÷åòûðåñòà ", "ïÿòüñîò ", "øåñòüñîò ", "ñåìüñîò ", "âîñåìüñîò ", "äåâÿòüñîò ")
     Nums4 = Array("", "îäíà ", "äâå ", "òðè ", "÷åòûðå ", "ïÿòü ", "øåñòü ", "ñåìü ", "âîñåìü ", "äåâÿòü ")
     Nums5 = Array("äåñÿòü ", "îäèííàäöàòü ", "äâåíàäöàòü ", "òðèíàäöàòü ", "÷åòûðíàäöàòü ", "ïÿòíàäöàòü ", "øåñòíàäöàòü ", "ñåìíàäöàòü ", "âîñåìíàäöàòü ", "äåâÿòíàäöàòü ")
     
     If n = 0 Then
     ScriptRus = ""
     Exit Function
     End If
     ed = Class(n, 1)
     dec = Class(n, 2)
     sot = Class(n, 3)
     tys = Class(n, 4)
     dectys = Class(n, 5)
     sottys = Class(n, 6)
     mil = Class(n, 7)
     decmil = Class(n, 8)
     sotmil = Class(n, 9)
     mlrd = Class(n, 10)
      
     If mlrd > 0 Then
     Select Case mlrd
     Case 1
     mlrd_txt = Nums1(mlrd) & "ìèëëèàðä "
     Case 2, 3, 4
     mlrd_txt = Nums1(mlrd) & "ìèëëèàðäà "
     Case 5 To 20
     mlrd_txt = Nums1(mlrd) & "ìèëëèàðäîâ "
     End Select
     End If
     If (sotmil + decmil + mil) > 0 Then
     sotmil_txt = Nums3(sotmil)
     
     Select Case decmil
     Case 1
     mil_txt = Nums5(mil) & "ìèëëèîíîâ "
     GoTo www
     Case 2 To 9
     decmil_txt = Nums2(decmil)
     End Select
     
     Select Case mil
     Case 1
     mil_txt = Nums1(mil) & "ìèëëèîí "
     Case 2, 3, 4
     mil_txt = Nums1(mil) & "ìèëëèîíà "
     Case 0, 5 To 20
     mil_txt = Nums1(mil) & "ìèëëèîíîâ "
     End Select
     End If
    www:
     sottys_txt = Nums3(sottys)
     Select Case dectys
     Case 1
     tys_txt = Nums5(tys) & "òûñÿ÷ "
     GoTo eee
     Case 2 To 9
     dectys_txt = Nums2(dectys)
     End Select
     
     Select Case tys
     Case 0
     If dectys > 0 Then tys_txt = Nums4(tys) & "òûñÿ÷ "
     Case 1
     tys_txt = Nums4(tys) & "òûñÿ÷à "
     Case 2, 3, 4
     tys_txt = Nums4(tys) & "òûñÿ÷è "
     Case 5 To 9
     tys_txt = Nums4(tys) & "òûñÿ÷ "
     End Select
     If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " òûñÿ÷ "
    eee:
     sot_txt = Nums3(sot)
     
     Select Case dec
     Case 1
     ed_txt = Nums5(ed)
     GoTo rrr
     Case 2 To 9
     dec_txt = Nums2(dec)
     End Select
     
     ed_txt = Nums1(ed)
    rrr:
     
     ScriptRus = mlrd_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
     ScriptRus = UCase(Left(ScriptRus, 1)) & LCase(Mid(ScriptRus, 2, Len(ScriptRus) - 1))
     End Function
     
    Private Function ScriptEng(ByVal Number As Double)
     Dim BigDenom As String, Temp As String
     Dim Count As Integer
      
     ReDim Place(9) As String
     Place(2) = " Thousand "
     Place(3) = " Million "
     Place(4) = " Billion "
     Place(5) = " Trillion "
      
     strAmount = Trim(Str(Int(Number)))
      
     Count = 1
     Do While strAmount <> ""
     Temp = GetHundreds(Right(strAmount, 3))
     If Temp <> "" Then BigDenom = Temp & Place(Count) & BigDenom
     If Len(strAmount) > 3 Then
     strAmount = Left(strAmount, Len(strAmount) - 3)
     Else
     strAmount = ""
     End If
     Count = Count + 1
     Loop
     Select Case BigDenom
     Case ""
     BigDenom = " "
     Case "One"
     BigDenom = " "
     Case Else
     BigDenom = BigDenom & " "
     End Select
     ScriptEng = BigDenom
     
    End Function
     
    Private Function GetHundreds(ByVal MyNumber)
     Dim result As String
     If Val(MyNumber) = 0 Then Exit Function
     MyNumber = Right("" & MyNumber, 3)
     
     If Mid(MyNumber, 1, 1) <> "" Then
     result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
     End If
     
     If Mid(MyNumber, 1, 1) <> "" And (Mid(MyNumber, 2, 1) <> "" Or Mid(MyNumber, 3, 1) <> "") Then
     result = result & "And "
     End If
     
     
     If Mid(MyNumber, 2, 1) <> "" Then
     result = result & GetTens(Mid(MyNumber, 2))
     Else
     result = result & GetDigit(Mid(MyNumber, 3))
     End If
     GetHundreds = result
    End Function
     
    Private Function GetTens(TensText)
     Dim result As String
     result = ""
     If Val(Left(TensText, 1)) = 1 Then
     Select Case Val(TensText)
     Case 10: result = "Ten"
     Case 11: result = "Eleven"
     Case 12: result = "Twelve"
     Case 13: result = "Thirteen"
     Case 14: result = "Fourteen"
     Case 15: result = "Fifteen"
     Case 16: result = "Sixteen"
     Case 17: result = "Seventeen"
     Case 18: result = "Eighteen"
     Case 19: result = "Nineteen"
     Case Else
     End Select
     Else
     Select Case Val(Left(TensText, 1))
     Case 2: result = "Twenty "
     Case 3: result = "Thirty "
     Case 4: result = "Forty "
     Case 5: result = "Fifty "
     Case 6: result = "Sixty "
     Case 7: result = "Seventy "
     Case 8: result = "Eighty "
     Case 9: result = "Ninety "
     Case Else
     End Select
     result = result & GetDigit _
     (Right(TensText, 1))
     End If
     GetTens = result
    End Function
     
    Private Function GetDigit(Digit)
     Select Case Val(Digit)
     Case 1: GetDigit = "One"
     Case 2: GetDigit = "Two"
     Case 3: GetDigit = "Three"
     Case 4: GetDigit = "Four"
     Case 5: GetDigit = "Five"
     Case 6: GetDigit = "Six"
     Case 7: GetDigit = "Seven"
     Case 8: GetDigit = "Eight"
     Case 9: GetDigit = "Nine"
     Case Else: GetDigit = ""
     End Select
    End Function
    Сообщение отредактировал FaNaTiK2495 19 февраля 2015 - 21:10

    19 февраля 2015 - 18:01 / #1
  2. KryBet
    Прародитель живого

    Оффлайн

    Сообщений: 5940

    Симпатий: 1499

    Трофеев: 33

    @Iline, это скриптовый язык для Office
    19 февраля 2015 - 18:45 / #2
  3. saiberpro
    Более чем богоподобный

    Оффлайн
    -11

    Сообщений: 1036

    Симпатий: 86

    Трофеев: 17

    @KriBetko, VBA если быть ещё точнее.

    19 февраля 2015 - 18:54 / #3
  4. KryBet
    Прародитель живого

    Оффлайн

    Сообщений: 5940

    Симпатий: 1499

    Трофеев: 33

    @saiberpro, а то юзер @Iline такой тупой, что в заголовке не прочитал.
    Ты лучше покажи, где вывод.

    *Подумал и через 3 минуты, 24 секунды добавил:*

    Это вывод?
    
    If lang = "RU" Then
    Select Case Money
    Case "RUB"
    Out = ScriptRus(whole) & " " & w_rus_r & " " & fraq & " " & f_rus_r
    Case "USD"
    Out = ScriptRus(whole) & " " & w_rus_d & " " & fraq & " " & f_rus_d
    Case "EUR"
    Out = ScriptRus(whole) & " " & w_rus_e & " " & fraq & " " & f_rus_e
    End Select
    End If
    
    If lang = "EN" Then
    Select Case Money
    Case "RUB"
    Out = ScriptEng(whole) & " " & w_en_r & " " & fraq & " " & f_en_r
    Case "USD"
    Out = ScriptEng(whole) & " " & w_en_d & " " & fraq & " " & f_en_d
    Case "EUR"
    Out = ScriptEng(whole) & " " & w_en_e & " " & fraq & " " & f_en_e
    End Select
    End If
    

    Тут нулям неоткуда браться.
    19 февраля 2015 - 18:55 / #4
  5. saiberpro
    Более чем богоподобный

    Оффлайн
    -11

    Сообщений: 1036

    Симпатий: 86

    Трофеев: 17

    @KriBetko, Нет насколько я понел это кейся для выбора языка перевода денег..

    20 февраля 2015 - 07:49 / #5
  6. Skipart
    Я — закон!

    Оффлайн

    Сообщений: 5399

    Симпатий: 2582

    Трофеев: 36

    @saiberpro, тебя не смущает, что это игровой портал? Задай свой вопрос на сайте своей тематики.

    "Демократия зло"
    Вас забанили модераторы? Ничего личного, просто работа...
    Если Вы не пользуетесь при продаже/покупке/обмене услугой гаранта от нашего сайта - скорей всего Вас кинут. empathy

    20 февраля 2015 - 08:21 / #6
  7. KryBet
    Прародитель живого

    Оффлайн

    Сообщений: 5940

    Симпатий: 1499

    Трофеев: 33

    Цитата: saiberpro
    @KriBetko, Нет насколько я понел это кейся для выбора языка перевода денег..

    А переменная Out должны быть тем самым выводом. Я не вижу, где ты там нули увидел.

    @Skipart, его там сразу в шею погонят, за такие глупые вопросы.
    20 февраля 2015 - 08:33 / #7
  8. saiberpro
    Более чем богоподобный

    Оффлайн
    -11

    Сообщений: 1036

    Симпатий: 86

    Трофеев: 17

    @KriBetko, В том то и дело что все жизненно важные нули я не стал трогать,а остальные удалил.Но всё равно он выводит вконце строки 0.

    20 февраля 2015 - 09:05 / #8
  9. KryBet
    Прародитель живого

    Оффлайн

    Сообщений: 5940

    Симпатий: 1499

    Трофеев: 33

    @saiberpro, покажи. Я не буду ставить Оффис ради этого.
    20 февраля 2015 - 09:06 / #9

Статистика форума, пользователей онлайн: 621 (за последние 15 минут)

Создано тем: 62102 Всего сообщений: 866425 Всего участников: 526746 Новый участник: Morphelus

Все материалы на форуме предоставляются участниками.

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