Prikazi cijelu temu 08.11.2016 20:23
Sijedi Van mreze
Clan
Registrovan od:05.07.2011
Lokacija:srebrenik


Predmet:Re: test vba kod
I ja sam nekad napravio tu funkciju, davnoooo
PreuzmiIzvorni kôd (Visual Basic):
  1. Function SlovimA(broj As Single)
  2. Dim rez As String, Cjeli As Integer, Dec As Single, CBroj As String
  3. Dim Duzina As Integer, i As Integer, Tric As String, cs As Integer, cj As Integer, cd As Integer
  4. Dim dDec As String, Slov As String
  5. Dim ImeBr(9) As String
  6. On Error GoTo Greska
  7.  broj = Trim(broj)
  8.    If (broj = 0) Then
  9.       SlovimA = "nula"
  10.       Exit Function
  11.    End If
  12.    ImeBr(1) = "jedan"
  13.    ImeBr(2) = "dva"
  14.    ImeBr(3) = "tri"
  15.    ImeBr(4) = "
  16. etiri"
  17.    ImeBr(5) = "pet"
  18.    ImeBr(6) = "Å¡est"
  19.    ImeBr(7) = "sedam"
  20.    ImeBr(8) = "osam"
  21.    ImeBr(9) = "devet"
  22.    rez = ""
  23.    Cjeli = Int(broj)
  24.    Dec = (broj - Cjeli) * 100
  25.    CBroj = Trim(Str(Cjeli)) ', 15)
  26.    Duzina = Len(CBroj)
  27.    CBroj = Space$(15 - Duzina) & CBroj
  28.    i = 1
  29.    Do While (i < 15)
  30.       Tric = Mid(CBroj, i, 3)
  31.       If (Tric <> "   " And (Tric <> "001" Or i = 4)) Then
  32.          cs = Val(Mid(Tric, 1, 1))
  33.          cd = Val(Mid(Tric, 2, 1))
  34.          cj = Val(Mid(Tric, 3, 1))
  35.          If (cs = 1) Then
  36.             rez = rez + "sto"
  37.          ElseIf (cs = 2) Then
  38.             rez = rez + "dvije"
  39.          ElseIf (cs > 2) Then
  40.             rez = rez + ImeBr(cs)
  41.          End If
  42.          If (cs > 4) Then
  43.             rez = rez + "stotina"
  44.          ElseIf (cs > 1) Then
  45.             rez = rez + "stotine"
  46.          End If
  47.          Select Case cd
  48.          Case 4
  49.             rez = rez + "
  50. etr"
  51.          Case 5
  52.             rez = rez + "pe"
  53.          Case 6
  54.             rez = rez + "Å¡ez"
  55.          Case 9
  56.             rez = rez + "deve"
  57.          Case Is > 1
  58.             rez = rez + ImeBr(cd)
  59.          Case 1
  60.             If (cj = 0) Then
  61.                rez = rez + "deset"
  62.             ElseIf (cj = 1) Then
  63.                rez = rez + "jeda"
  64.             ElseIf (cj = 4) Then
  65.                rez = rez + "
  66. etr"
  67.             Else
  68.                rez = rez + ImeBr(cj)
  69.             End If
  70.             If (cj > 0) Then
  71.                rez = rez + "naest"
  72.             End If
  73.          Case Else
  74.          End Select
  75.          If (cd > 1) Then
  76.             rez = rez + "deset"
  77.          End If
  78.          If (cd <> 1 And cj <> 0 And (i = 13 Or Val(Tric) <> 1)) Then
  79.             If (cj = 2 And i <> 13 And i <> 7) Then
  80.                rez = rez + "dvije"
  81.             Else
  82.                rez = rez + ImeBr(cj)
  83.             End If
  84.          End If
  85.          If ((i = 1 Or i = 10) And cs + cd + cj <> 0) Then
  86.             rez = rez + "hiljad"
  87.             If (Val(Tric) = 1) Then
  88.                rez = rez + "u"
  89.             ElseIf (cj > 4 Or cj = 0) Then
  90.                rez = rez + "a"
  91.             ElseIf (cj > 1) Then
  92.                rez = rez + "e"
  93.             End If
  94.          ElseIf (i = 4 And cs + cd + cj <> 0) Then
  95.             rez = rez + "milijard"
  96.             If (Val(Tric) = 1) Then
  97.                rez = rez + "u"
  98.             ElseIf (cj > 4 Or cj = 0) Then
  99.                rez = rez + "i"
  100.             ElseIf (cj > 1) Then
  101.                rez = rez + "e"
  102.             End If
  103.          ElseIf (i = 7 And cs + cd + cj <> 0) Then
  104.             rez = rez + "milion"
  105.             If (cj <> 1) Then
  106.                rez = rez + "a"
  107.             End If
  108.          End If
  109.       ElseIf (Tric = "001") Then
  110.          rez = rez + "jedan"
  111.       End If
  112.       i = i + 3
  113.    Loop
  114.    dDec = Str(Val(Dec)) ', 2)
  115.   Slov = rez + " " + dDec + "/100"
  116.    SlovimA = Slov
  117.  Exit Function
  118. Greska:
  119.  SlovimA = "NEIZRECIVO"
  120. End Function