Eto vi edna funkcia za prevrahtane na cifri vav suma slovom na balgarski. Ne e pisana ot men - ot Plamen ot Plovdiv e, i e testvana veche 2 godini v edin moi proekt za ABB Eto ia: Function Slovom(Suma As String) 'Функцията е написана от Пламен 'Частично е редактирана от Николай Унгузов Dim duma As String, a(35), d(15), i, s1, s2, s3, s4, s5, z Dim позиция As Integer, дължина As Integer Dim PozZ As Integer Dim TempStr As String Dim hui1 As Currency On Error GoTo er PozZ = InStr(1, Suma, ",", vbTextCompare) 'TempStr = Right(suma, PozZ - 1) TempStr = Str(Val(CCur(Val(Suma)))) If Len(TempStr) > 2 Then Suma = Left(Suma, PozZ + 2) дължина = Len(Suma) позиция = InStr(1, Suma, ",", vbTextCompare) 'Взимам позицията на десетичната запетая If позиция = дължина Then MsgBox "Моля запишете някакво число след запетайката, или я изтрийте !", vbCritical Exit Function End If For z = 1 To дължина If Mid$(Suma, z, 1) <> " " Then duma = duma + Mid$(Suma, z, 1) Next z If позиция = 0 Then duma = duma + "," + "00" Else позиция = дължина - (позиция - 1) 'Позицията е между 2 и 3 If позиция = 2 Then duma = duma + "0" Else 'Няма нужда от добавяне на 0 End If End If Suma = duma duma = "" дължина = Len(Suma) 'Взимам новата дължина Do i = (-7 + (Fix((дължина - 1) / 3) + 1) * 7) If дължина = 3 Then d(дължина) = 0 дължина = дължина - 1 GoTo sledwast End If d(дължина) = Val(Mid$(Suma, (Len(Suma) - дължина + 1), 1)) Select Case дължина Case 1, 4, 7, 10, 13 GoSub edinici Case 2, 5, 8, 11, 14 GoSub desetici Case 6, 9, 12, 15 GoSub stotici Case Else MsgBox "Грешка в модула за отчитане на цифрите", vbCritical Exit Function End Select sledwast: Loop While дължина > 0 For z = (Len(Suma) + 1) To 15 d(z) = 0 Next z mlrd: If (d(15) + d(14)) = 0 Then If d(13) = 1 Then a(30) = " милиард" GoTo mln Else If d(13) = 0 Then a(30) = "" GoTo mln Else a(30) = " милиарда" GoTo mln End If End If Else a(30) = " милиарда" End If mln: If (d(12) + d(11)) = 0 Then If d(10) = 1 Then a(23) = " милион" GoTo hil Else If d(10) = 0 Then a(23) = "" GoTo hil Else a(23) = " милиона" GoTo hil End If End If Else a(23) = " милиона" End If hil: If (d(9) + d(8)) = 0 Then If d(7) = 1 Then a(16) = " хиляда" a(17) = "" GoTo lv Else If d(7) = 0 Then a(16) = "" GoTo lv Else a(16) = " хиляди" GoTo lv End If End If Else a(16) = " хиляди" End If lv: If (d(15) + d(14) + d(13) + d(12) + d(11) + d(10) + d(9) + d(8) + d(7) + d(6) + d(5)) = 0 Then If d(4) = 0 Then GoTo stotinki Else If d(4) = 1 Then a(9) = " лев" GoTo stotinki Else a(9) = " лева" GoTo stotinki End If End If Else a(9) = " лева" GoTo stotinki End If stotinki: If d(2) > 0 Then a(2) = " стотинки" GoTo niz Else If d(1) = 0 Then a(2) = "" GoTo niz Else If d(1) = 1 Then a(2) = " стотинка" GoTo niz Else a(2) = " стотинки" GoTo niz End If End If End If niz: If (d(15) + d(14) + d(13)) > 0 Then s1 = 1 If (d(12) + d(11) + d(10)) > 0 Then s2 = 1 If (d(9) + d(8) + d(7)) > 0 Then s3 = 1 If (d(6) + d(5) + d(4)) > 0 Then s4 = 1 If (d(2) + d(1)) > 0 Then s5 = 1 If s1 + s2 + s3 + s4 >= 2 Then If s4 > 0 Then a(15) = " и" GoTo st Else If s3 > 0 Then a(22) = " и" GoTo st Else If s2 > 0 Then a(29) = " и" GoTo st Else GoTo st End If End If End If End If st: If s5 > 0 Then If s1 + s2 + s3 + s4 > 0 Then If a(6) = "" Then a(8) = " и" a(29) = "": a(22) = "": a(15) = "" End If End If ok: For z = 35 To 1 Step -1 duma = duma + a(z) Next z Do While Left$(duma, 1) = " " duma = Right$(duma, (Len(duma) - 1)) Loop If duma = "" Then duma = "-" Slovom = duma GoTo ex: stotici: Select Case d(дължина) Case 0 a(7 + i) = "" Case 1 a(7 + i) = " сто" Case 2 a(7 + i) = " двеста" Case 3 a(7 + i) = " триста" Case 4 a(7 + i) = " четиристотин" Case 5 a(7 + i) = " петстотин" Case 6 a(7 + i) = " шестстотин" Case 7 a(7 + i) = " седемстотин" Case 8 a(7 + i) = " осемстотин" Case 9 a(7 + i) = " деветстотин" Case Else MsgBox "Възниква непредвидена грешка при стотиците", vbCritical Exit Function End Select дължина = дължина - 1 GoSub desetici Return desetici: d(дължина) = Val(Mid$(Suma, (Len(Suma) - дължина + 1), 1)) Select Case d(дължина) Case 0 a(5 + i) = "" Case 1 a(5 + i) = "" Case 2 a(5 + i) = " двадесет" Case 3 a(5 + i) = " тридесет" Case 4 a(5 + i) = " четиридесет" Case 5 a(5 + i) = " петдесет" Case 6 a(5 + i) = " шестдесет" Case 7 a(5 + i) = " седемдесет" Case 8 a(5 + i) = " осемдесет" Case 9 a(5 + i) = " деветдесет" Case Else MsgBox "Възниква грешка в модула за десетците", vbCritical Exit Function End Select дължина = дължина - 1 GoSub edinici Return edinici: d(дължина) = Val(Mid$(Suma, (Len(Suma) - дължина + 1), 1)) If (Len(Suma) - дължина > 0) And (d(дължина + 1) = 1) Then Select Case d(дължина) Case 0 a(3 + i) = " десет" Case 1 a(3 + i) = " единадесет" Case 2 a(3 + i) = " дванадесет" Case 3 a(3 + i) = " тринадесет" Case 4 a(3 + i) = " четиринадесет" Case 5 a(3 + i) = " петнадесет" Case 6 a(3 + i) = " шестнадесет" Case 7 a(3 + i) = " седемнадесет" Case 8 a(3 + i) = " осемнадесет" Case 9 a(3 + i) = " деветнадесет" Case Else MsgBox "Възниква грешка в модула за числата от 11-19", vbCritical Exit Function End Select If d(дължина + 2) > 0 Then a(6 + i) = " и" дължина = дължина - 1 Return End If Select Case d(дължина) Case 0 a(3 + i) = "" If d(дължина + 1) > 0 Then a(6 + i) = " и" Case 1 If Fix((дължина - 1) / 3) = 0 Then a(3 + i) = " една" Else a(3 + i) = " един" End If Case 2 If (Fix((дължина - 1) / 3) = 0) Or (Fix((дължина - 1) / 3) = 2) Or дължина = 2 Then a(3 + i) = " две" Else a(3 + i) = " два" End If Case 3 a(3 + i) = " три" Case 4 a(3 + i) = " четири" Case 5 a(3 + i) = " пет" Case 6 a(3 + i) = " шест" Case 7 a(3 + i) = " седем" Case 8 a(3 + i) = " осем" Case 9 a(3 + i) = " девет" Case Else MsgBox "Възниква грешка при единиците", vbCritical Exit Function End Select If d(дължина) > 0 Then If d(дължина + 1) > 0 Or d(дължина + 2) > 0 Then a(4 + i) = " и" End If дължина = дължина - 1 Return ex: Exit Function er: MsgBox Err & Error$ End End Function