[ PatroXL @ 10.07.2013. 17:19 ] @
Pretvaranja broja u slova je odavno poznato ali ja sam to malo doradio da postoji razmak izmedju reci, odnosno da ne pise pethiljadapetstopedestpetdinara nego lepo pet hiljada pet stotina pedeset pet dinara. Code: Function slovima(broj) If broj = 0 Then rez = "nula" ReDim imebr(9) imebr(1) = "jedan" imebr(2) = "dva" imebr(3) = "tri" imebr(4) = ChrW(269) & "etiri " imebr(5) = "pet " imebr(6) = "šest " imebr(7) = "sedam" imebr(8) = "osam" imebr(9) = "devet " 'rez = "" celi = Int(broj) dec = ((broj - celi) * 100) Mod 100 If celi = 0 Then rez = "nula" GoTo Kraj Else rez = "" End If cbr = Str(celi) duzina = 16 - Len(cbr) cBroj = String(duzina, "0") & Right(cbr, Len(cbr) - 1) i = 1 Do While i < 15 tric = Mid(cBroj, i, 3) trojka = Val(tric) If tric <> "000" Then cs = Val(Mid(tric, 1, 1)) cd = Val(Mid(tric, 2, 1)) cj = Val(Mid(tric, 3, 1)) Select Case cs Case 2 rez = rez & "dve " Case Is > 2 rez = rez & imebr(cs) End Select Select Case cs Case 1 rez = rez & " stotinu " Case 2, 3, 4 rez = rez & " stotine " Case Is > 4 rez = rez & " stotina " End Select If cj = 0 Then sl1 = "" Else sl1 = imebr(cj) Select Case cd Case 4 rez = rez & ChrW(269) & "etr" Case 6 rez = rez & "šez" Case 5 rez = rez & "pe" Case 9 rez = rez & "deve" Case 2, 3, 7, 8 rez = rez & imebr(cd) Case 1 sl1 = "" Select Case cj Case 0 rez = rez & "deset " Case 1 rez = rez & "jeda" Case 4 rez = rez & ChrW(269) & "etr" Case 6 rez = rez & "šes" Case Else rez = rez & imebr(cj) End Select If cj > 0 Then rez = rez & "naest " End Select If cd > 1 Then rez = rez & "deset " If (i = 4 Or i = 10) And cd <> 1 Then If cj = 1 Then sl1 = "jedna " ElseIf cj = 2 Then sl1 = "dve " End If End If rez = rez & sl1 Select Case i Case 1 rez = rez & "bilion" If cj > 1 Or cd = 1 Then rez = rez & "a " Case 4 rez = rez & "milijard" If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Then rez = rez & "i " ElseIf cj = 1 Then rez = rez & "a " ElseIf cj > 4 Or cj = 0 Then rez = rez & "i " ElseIf cj > 1 Then rez = rez & "e " End If Case 7 rez = rez & "milion" If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj <> 1 Then rez = rez & "a " End If Case 10 rez = rez & " hiljad" If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj = 1 Then rez = rez & "a " ElseIf trojka = 1 Then rez = rez & "u " ElseIf cj > 4 Or cj = 0 Then rez = rez & "a " ElseIf cj > 1 Then rez = rez & "e " End If End Select End If i = i + 3 Loop Kraj: slovima = rez & " dinara i " & slovimapare(dec) End Function Function slovimapare(broj) As String ' Konvertuje broj od 0 do 99 u tekst ' P.Jovanovic 29/3/2006 za EliteSecurity Forum ' Dim cBroj As String ReDim imebr(9) imebr(1) = "jedan" imebr(2) = "dva" imebr(3) = "tri" imebr(4) = ChrW(269) & "etiri " imebr(5) = "pet " imebr(6) = "šest " imebr(7) = "sedam" imebr(8) = "osam" imebr(9) = "devet " cBroj = Format(broj, "00") cd = Val(Mid(cBroj, 1, 1)) cj = Val(Mid(cBroj, 2, 1)) If broj = 0 Then slovimapare = "nula para" GoTo Kraj End If If cj = 0 Then sl1 = "" Else sl1 = imebr(cj) Select Case cd Case 4 rez = rez & ChrW(269) & "etr" Case 6 rez = rez & "šez" Case 5 rez = rez & "pe" Case 9 rez = rez & "deve" Case 2, 3, 7, 8 rez = rez & imebr(cd) Case 1 sl1 = "" Select Case cj Case 0 rez = rez & "deset " Case 1 rez = rez & "jeda" Case 4 rez = rez & ChrW(269) & "etr" Case Else rez = rez & imebr(cj) End Select If cj > 0 Then rez = rez & "naest " End Select If cd > 1 Then rez = rez & "deset " If cd <> 1 Then If cj = 1 Then sl1 = "jedna " ElseIf cj = 2 Then sl1 = "dve " End If End If rez = rez & sl1 & " par" If cj >= 2 And cj <= 4 And cd <> 1 Then rez = rez & "e" Else rez = rez & "a" slovimapare = rez Kraj: End Function Ovu funkciju mozete naravno da koristite i u Accessu. Pozdrav i prijatan dan PatroXL [Ovu poruku je menjao PatroXL dana 10.07.2013. u 20:09 GMT+1] |