Centar za edukaciju-BiH

iCentar → iC → Test_forum → test vba kod


Odgovori na temu





Pomoc


Prosiri Boja Prosiri Velicina Spoiler WMP-Videos Neprimjereno
Podebljano Kurziv Podvuceno Slika Internet adresa (URL) Citat Van teme Neuredena lista Narucena lista Pretplata Nadredeni
Grinning Happy Cool Surprised Disappointed Laughing In love Angry No comment Embarrassing Shy Smiling Tongue Undecided Innocent Wink Sad Prosiri i skupi vise smajlica
Povecaj velicinu · Smanji velicinu Provjeri duzinu
Pretvori smajlice u postu
Pretvori & quot; vokable & quot; u postu

Upravljanje prilozima
Mozete priloziti 3 datoteke!



Posljednjih 15 postova u ovoj temi


Gjoreski (10.11.2016 21:58):
Predmet: Re: test vba kod
Opet cu da kazem kad jedna funkcija treba ti desetina puta u toku posla ne treba se puno truditi.

zxz (10.11.2016 11:21):
Predmet: Re: test vba kod
Ja sam je pravio cak dva puta.
Jednom uradio i izgubio negdje nisam mogao naci.
Ponovo sjeo i napravio ali i dalje mislim da se moze mnogo strukturalnije napraviti samo bi trebalo sjesti i razmisliti.

Gjoreski (10.11.2016 11:05):
Predmet: Re: test vba kod
pa koriste se tih funkcija. Obicno svi mi koi rdimo komercijala mislim na aplikacije koi su nesto kao matrijalno i finansovo imamo tu funkciju.Samo sad sa internetom moze se naci lakse ta funkcija i skoro nikoje ne ja pravi ili je vec nasao gotova i ja koristi.

zxz (09.11.2016 18:45):
Predmet: Re: test vba kod
Nisam ni znao da ih ima toliko uradjenih.
Nekad su treabale a sad izgleda ne trebaju nigdje ili se varam.

Sijedi (08.11.2016 20:23):
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

zxz (28.10.2016 19:10):
Predmet: Re: test vba kod
igleda da je ipak do mene.
da nisam kopirao sve.
Sjecam se samo da sam izbjegavao kopirati ovaj rem na pocetku i na kraju gdje sam uokvirio da se ove procedure odnose na na istu stvar.

zxz (28.10.2016 19:08):
Predmet: mozda naslov da vidim
PreuzmiIzvorni kôd (Visual Basic):
  1. '*----------------------------------broj slovima-----------------------------------------------------
  2. '*--------------------------------------------------------------------------------------------------------
  3. Function BrSlovima(Broj) As String
  4. '******************************************
  5. 'Ime:     BrSlovima Function
  6. 'Sadržaj: ispisuje broj tekstom
  7. 'Autor:     ZXZ
  8. 'Datum:      08 16, 2009, 12:34:16
  9. 'Adresa: Tuzla BiH
  10. 'Email:     izonic@inet.ba
  11. 'Ulazni parametri:broj
  12. 'Izlazni parametri:broj ispisan tekstom
  13. '*****************************************
  14. Dim I1 As Integer, I2 As Integer
  15. Dim N1 As Integer, N2 As Integer
  16. Dim DioTri As String
  17. Dim MjestoTri As Integer
  18. Dim RodJ As Integer
  19. Dim Strb As String
  20. Dim Cifra As Integer
  21. Dim Str(1 To 2) As String
  22.  
  23. 'Broj = 112
  24.  
  25. N1 = Fix(Len(Format$(Broj)) / 3)
  26. If Len(Format$(Broj)) Mod 3 > 0 Then
  27. N1 = N1 + 1
  28. End If
  29. For I1 = 1 To N1
  30.  If I1 = 3 Then
  31.    RodJ = 1
  32.  Else
  33.    RodJ = 2
  34.  End If
  35.  
  36.     If I1 = N1 Then
  37.      MjestoTri = 1
  38.      N2 = Len(Format$(Broj)) Mod 3
  39.      If N2 = 0 Then: N2 = 3
  40.     Else
  41.      N2 = 3
  42.      MjestoTri = Len(Format$(Broj)) - I1 * 3 + 1
  43.     End If
  44.    
  45. DioTri = Mid(Format$(Broj), MjestoTri, N2)
  46.     For I2 = 1 To N2
  47.      Cifra = Mid(DioTri, N2 - I2 + 1, 1)
  48.         If Cifra = 1 And Strb = "
  49. etiri" Then
  50.         Strb = "
  51. etr"
  52.         End If
  53.        
  54.         If Cifra = 1 And Strb = "Å¡est" Then
  55.         Strb = "Å¡es"
  56.         End If
  57.         Str(1) = Cifre(Cifra, I2, I1)
  58.         If Str(1) = "naest" And Str(2) = "jedan" Then
  59.          Str(1) = "aest"
  60.         End If
  61.         If Str(1) = "nula" Then GoTo Petlja
  62.         If Cifra = 1 And I2 = 2 Then
  63.         If Str(2) = "nula" Then Str(1) = "deset"
  64.         Strb = Strb & Str(1)
  65.         Else
  66.         Strb = Str(1) & Strb
  67.         End If
  68. Petlja:
  69. Str(2) = Str(1)
  70.     Next I2
  71.    
  72.  BrSlovima = Strb & ImenaB(DioTri, RodJ, I1) & BrSlovima
  73.  Strb = ""
  74. Next I1
  75. End Function
  76.  
  77. Function Cifre(Cifra As Integer, PoRedu As Integer, Rod As Integer) As String
  78.  
  79. Select Case Cifra
  80.  
  81. Case 0
  82.     Cifre = "nula"
  83.     GoTo Kraj
  84. Case 1
  85. If PoRedu = 1 Then
  86.     If Rod = 1 Or Rod = 3 Or Rod = 5 Then
  87.     Cifre = "jedan"
  88.     Else
  89.     Cifre = "jedna"
  90.     End If
  91. ElseIf PoRedu = 2 Then
  92.     Cifre = "jeda"
  93. End If
  94. Case 2
  95. If PoRedu = 1 Or PoRedu = 3 Then
  96.     If Rod = 1 Or Rod = 3 Or Rod = 5 Then
  97.     Cifre = "dva"
  98.     Else
  99.     Cifre = "dvije"
  100.     End If
  101. ElseIf PoRedu = 2 Then
  102. Cifre = "dva"
  103. End If
  104. Case 3
  105.    Cifre = "tri"
  106. Case 4
  107.     If PoRedu = 1 Or PoRedu = 3 Then
  108.     Cifre = "
  109. etiri"
  110.     Else
  111.     Cifre = "
  112. etr"
  113.     End If
  114. Case 5
  115.     If PoRedu = 2 Then
  116.     Cifre = "pe"
  117.     Else
  118.     Cifre = "pet"
  119.     End If
  120. Case 6
  121.     If PoRedu = 2 Then
  122.     Cifre = "Å¡ez"
  123.     Else
  124.     Cifre = "Å¡est"
  125.     End If
  126. Case 7
  127.     Cifre = "sedam"
  128. Case 8
  129.     Cifre = "osam"
  130. Case 9
  131.     If PoRedu = 2 Then
  132.     Cifre = "deve"
  133.     Else
  134.     Cifre = "devet"
  135.     End If
  136. End Select
  137. If PoRedu = 2 Then
  138.   If Cifra = 1 Then
  139.      Cifre = "naest"
  140.   Else
  141.      Cifre = Cifre & "deset"
  142.   End If
  143. ElseIf PoRedu = 3 Then
  144.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  145.     Cifre = Cifre & "stotine"
  146.     ElseIf Cifra = 1 Then
  147.     Cifre = "stotinu"
  148.     ElseIf Cifra = 0 Then
  149.     Else
  150.     Cifre = Cifre & "stotina"
  151.     End If
  152. End If
  153. Kraj:
  154. End Function
  155.  
  156. Function ImenaB(StrBr As String, Rod As Integer, PoRedu) As String
  157. Dim Cifra As Integer
  158. Dim Druga As Integer
  159.  
  160. If Val(StrBr) = 0 Then GoTo Kraj
  161. Cifra = Val(Right(StrBr, 1))
  162. If Len(StrBr) > 1 Then
  163. Druga = Val(Mid(StrBr, Len(StrBr) - 1, 1))
  164. End If
  165.  
  166. Select Case PoRedu
  167.  
  168. Case 1
  169. 'ništa
  170. Case 2
  171.    
  172.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  173.         If Druga = 1 Then
  174.         ImenaB = "hiljada"
  175.         Else
  176.         ImenaB = "hiljade"
  177.         End If
  178.     Else
  179.     ImenaB = "hiljada"
  180.     End If
  181. Case 3
  182.     If Cifra = 1 Then
  183.         If Druga = 1 Then
  184.         ImenaB = "miliona"
  185.         Else
  186.         ImenaB = "milion"
  187.         End If
  188.     Else
  189.     ImenaB = "miliona"
  190.     End If
  191. Case 4
  192.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  193.         If Druga = 1 Then
  194.         ImenaB = "milijardi"
  195.         Else
  196.         ImenaB = "milijarde"
  197.         End If
  198.     ElseIf Cifra = 1 Then
  199.         If Druga = 1 Then
  200.         ImenaB = "milijardi"
  201.         Else
  202.         ImenaB = "milijarda"
  203.         End If
  204.     Else
  205.     ImenaB = "milijardi"
  206.     End If
  207. Case 5
  208. End Select
  209. Kraj:
  210. End Function
  211. '*--------------------------------------broj slovima kraj-------------------------------------------------

zxz (28.10.2016 18:26):
Predmet: Re: test vba kod
PreuzmiIzvorni kôd (Visual Basic):
  1. '*----------------------------------broj slovima-----------------------------------------------------
  2. '*--------------------------------------------------------------------------------------------------------
  3. Function BrSlovima(Broj) As String
  4. '******************************************
  5. 'Ime:     BrSlovima Function
  6. 'Sadržaj: ispisuje broj tekstom
  7. 'Autor:     ZXZ
  8. 'Datum:      08 16, 2009, 12:34:16
  9. 'Adresa: Tuzla BiH
  10. 'Email:     izonic@inet.ba
  11. 'Ulazni parametri:broj
  12. 'Izlazni parametri:broj ispisan tekstom
  13. '*****************************************
  14. Dim I1 As Integer, I2 As Integer
  15. Dim N1 As Integer, N2 As Integer
  16. Dim DioTri As String
  17. Dim MjestoTri As Integer
  18. Dim RodJ As Integer
  19. Dim Strb As String
  20. Dim Cifra As Integer
  21. Dim Str(1 To 2) As String
  22.  
  23. 'Broj = 112
  24.  
  25. N1 = Fix(Len(Format$(Broj)) / 3)
  26. If Len(Format$(Broj)) Mod 3 > 0 Then
  27. N1 = N1 + 1
  28. End If
  29. For I1 = 1 To N1
  30.  If I1 = 3 Then
  31.    RodJ = 1
  32.  Else
  33.    RodJ = 2
  34.  End If
  35.  
  36.     If I1 = N1 Then
  37.      MjestoTri = 1
  38.      N2 = Len(Format$(Broj)) Mod 3
  39.      If N2 = 0 Then: N2 = 3
  40.     Else
  41.      N2 = 3
  42.      MjestoTri = Len(Format$(Broj)) - I1 * 3 + 1
  43.     End If
  44.    
  45. DioTri = Mid(Format$(Broj), MjestoTri, N2)
  46.     For I2 = 1 To N2
  47.      Cifra = Mid(DioTri, N2 - I2 + 1, 1)
  48.         If Cifra = 1 And Strb = "
  49. etiri" Then
  50.         Strb = "
  51. etr"
  52.         End If
  53.        
  54.         If Cifra = 1 And Strb = "Å¡est" Then
  55.         Strb = "Å¡es"
  56.         End If
  57.         Str(1) = Cifre(Cifra, I2, I1)
  58.         If Str(1) = "naest" And Str(2) = "jedan" Then
  59.          Str(1) = "aest"
  60.         End If
  61.         If Str(1) = "nula" Then GoTo Petlja
  62.         If Cifra = 1 And I2 = 2 Then
  63.         If Str(2) = "nula" Then Str(1) = "deset"
  64.         Strb = Strb & Str(1)
  65.         Else
  66.         Strb = Str(1) & Strb
  67.         End If
  68. Petlja:
  69. Str(2) = Str(1)
  70.     Next I2
  71.    
  72.  BrSlovima = Strb & ImenaB(DioTri, RodJ, I1) & BrSlovima
  73.  Strb = ""
  74. Next I1
  75. End Function
  76.  
  77. Function Cifre(Cifra As Integer, PoRedu As Integer, Rod As Integer) As String
  78.  
  79. Select Case Cifra
  80.  
  81. Case 0
  82.     Cifre = "nula"
  83.     GoTo Kraj
  84. Case 1
  85. If PoRedu = 1 Then
  86.     If Rod = 1 Or Rod = 3 Or Rod = 5 Then
  87.     Cifre = "jedan"
  88.     Else
  89.     Cifre = "jedna"
  90.     End If
  91. ElseIf PoRedu = 2 Then
  92.     Cifre = "jeda"
  93. End If
  94. Case 2
  95. If PoRedu = 1 Or PoRedu = 3 Then
  96.     If Rod = 1 Or Rod = 3 Or Rod = 5 Then
  97.     Cifre = "dva"
  98.     Else
  99.     Cifre = "dvije"
  100.     End If
  101. ElseIf PoRedu = 2 Then
  102. Cifre = "dva"
  103. End If
  104. Case 3
  105.    Cifre = "tri"
  106. Case 4
  107.     If PoRedu = 1 Or PoRedu = 3 Then
  108.     Cifre = "
  109. etiri"
  110.     Else
  111.     Cifre = "
  112. etr"
  113.     End If
  114. Case 5
  115.     If PoRedu = 2 Then
  116.     Cifre = "pe"
  117.     Else
  118.     Cifre = "pet"
  119.     End If
  120. Case 6
  121.     If PoRedu = 2 Then
  122.     Cifre = "Å¡ez"
  123.     Else
  124.     Cifre = "Å¡est"
  125.     End If
  126. Case 7
  127.     Cifre = "sedam"
  128. Case 8
  129.     Cifre = "osam"
  130. Case 9
  131.     If PoRedu = 2 Then
  132.     Cifre = "deve"
  133.     Else
  134.     Cifre = "devet"
  135.     End If
  136. End Select
  137. If PoRedu = 2 Then
  138.   If Cifra = 1 Then
  139.      Cifre = "naest"
  140.   Else
  141.      Cifre = Cifre & "deset"
  142.   End If
  143. ElseIf PoRedu = 3 Then
  144.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  145.     Cifre = Cifre & "stotine"
  146.     ElseIf Cifra = 1 Then
  147.     Cifre = "stotinu"
  148.     ElseIf Cifra = 0 Then
  149.     Else
  150.     Cifre = Cifre & "stotina"
  151.     End If
  152. End If
  153. Kraj:
  154. End Function
  155.  
  156. Function ImenaB(StrBr As String, Rod As Integer, PoRedu) As String
  157. Dim Cifra As Integer
  158. Dim Druga As Integer
  159.  
  160. If Val(StrBr) = 0 Then GoTo Kraj
  161. Cifra = Val(Right(StrBr, 1))
  162. If Len(StrBr) > 1 Then
  163. Druga = Val(Mid(StrBr, Len(StrBr) - 1, 1))
  164. End If
  165.  
  166. Select Case PoRedu
  167.  
  168. Case 1
  169. 'ništa
  170. Case 2
  171.    
  172.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  173.         If Druga = 1 Then
  174.         ImenaB = "hiljada"
  175.         Else
  176.         ImenaB = "hiljade"
  177.         End If
  178.     Else
  179.     ImenaB = "hiljada"
  180.     End If
  181. Case 3
  182.     If Cifra = 1 Then
  183.         If Druga = 1 Then
  184.         ImenaB = "miliona"
  185.         Else
  186.         ImenaB = "milion"
  187.         End If
  188.     Else
  189.     ImenaB = "miliona"
  190.     End If
  191. Case 4
  192.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  193.         If Druga = 1 Then
  194.         ImenaB = "milijardi"
  195.         Else
  196.         ImenaB = "milijarde"
  197.         End If
  198.     ElseIf Cifra = 1 Then
  199.         If Druga = 1 Then
  200.         ImenaB = "milijardi"
  201.         Else
  202.         ImenaB = "milijarda"
  203.         End If
  204.     Else
  205.     ImenaB = "milijardi"
  206.     End If
  207. Case 5
  208. End Select
  209. Kraj:
  210. End Function
  211. '*--------------------------------------broj slovima kraj-------------------------------------------------

zxz (28.10.2016 18:25):
Predmet: Re: test vba kod
E ja ovo nisam uspio ni iz tri pokusaja.
sad cu ponovo:
PreuzmiIzvorni kôd (Visual Basic):
  1. '*----------------------------------broj slovima-----------------------------------------------------
  2. '*--------------------------------------------------------------------------------------------------------
  3. Function BrSlovima(Broj) As String
  4. '******************************************
  5. 'Ime:     BrSlovima Function
  6. 'Sadržaj: ispisuje broj tekstom
  7. 'Autor:     ZXZ
  8. 'Datum:      08 16, 2009, 12:34:16
  9. 'Adresa: Tuzla BiH
  10. 'Email:     izonic@inet.ba
  11. 'Ulazni parametri:broj
  12. 'Izlazni parametri:broj ispisan tekstom
  13. '*****************************************
  14. Dim I1 As Integer, I2 As Integer
  15. Dim N1 As Integer, N2 As Integer
  16. Dim DioTri As String
  17. Dim MjestoTri As Integer
  18. Dim RodJ As Integer
  19. Dim Strb As String
  20. Dim Cifra As Integer
  21. Dim Str(1 To 2) As String
  22.  
  23. 'Broj = 112
  24.  
  25. N1 = Fix(Len(Format$(Broj)) / 3)
  26. If Len(Format$(Broj)) Mod 3 > 0 Then
  27. N1 = N1 + 1
  28. End If
  29. For I1 = 1 To N1
  30.  If I1 = 3 Then
  31.    RodJ = 1
  32.  Else
  33.    RodJ = 2
  34.  End If
  35.  
  36.     If I1 = N1 Then
  37.      MjestoTri = 1
  38.      N2 = Len(Format$(Broj)) Mod 3
  39.      If N2 = 0 Then: N2 = 3
  40.     Else
  41.      N2 = 3
  42.      MjestoTri = Len(Format$(Broj)) - I1 * 3 + 1
  43.     End If
  44.    
  45. DioTri = Mid(Format$(Broj), MjestoTri, N2)
  46.     For I2 = 1 To N2
  47.      Cifra = Mid(DioTri, N2 - I2 + 1, 1)
  48.         If Cifra = 1 And Strb = "
  49. etiri" Then
  50.         Strb = "
  51. etr"
  52.         End If
  53.        
  54.         If Cifra = 1 And Strb = "Å¡est" Then
  55.         Strb = "Å¡es"
  56.         End If
  57.         Str(1) = Cifre(Cifra, I2, I1)
  58.         If Str(1) = "naest" And Str(2) = "jedan" Then
  59.          Str(1) = "aest"
  60.         End If
  61.         If Str(1) = "nula" Then GoTo Petlja
  62.         If Cifra = 1 And I2 = 2 Then
  63.         If Str(2) = "nula" Then Str(1) = "deset"
  64.         Strb = Strb & Str(1)
  65.         Else
  66.         Strb = Str(1) & Strb
  67.         End If
  68. Petlja:
  69. Str(2) = Str(1)
  70.     Next I2
  71.    
  72.  BrSlovima = Strb & ImenaB(DioTri, RodJ, I1) & BrSlovima
  73.  Strb = ""
  74. Next I1
  75. End Function
  76.  
  77. Function Cifre(Cifra As Integer, PoRedu As Integer, Rod As Integer) As String
  78.  
  79. Select Case Cifra
  80.  
  81. Case 0
  82.     Cifre = "nula"
  83.     GoTo Kraj
  84. Case 1
  85. If PoRedu = 1 Then
  86.     If Rod = 1 Or Rod = 3 Or Rod = 5 Then
  87.     Cifre = "jedan"
  88.     Else
  89.     Cifre = "jedna"
  90.     End If
  91. ElseIf PoRedu = 2 Then
  92.     Cifre = "jeda"
  93. End If
  94. Case 2
  95. If PoRedu = 1 Or PoRedu = 3 Then
  96.     If Rod = 1 Or Rod = 3 Or Rod = 5 Then
  97.     Cifre = "dva"
  98.     Else
  99.     Cifre = "dvije"
  100.     End If
  101. ElseIf PoRedu = 2 Then
  102. Cifre = "dva"
  103. End If
  104. Case 3
  105.    Cifre = "tri"
  106. Case 4
  107.     If PoRedu = 1 Or PoRedu = 3 Then
  108.     Cifre = "
  109. etiri"
  110.     Else
  111.     Cifre = "
  112. etr"
  113.     End If
  114. Case 5
  115.     If PoRedu = 2 Then
  116.     Cifre = "pe"
  117.     Else
  118.     Cifre = "pet"
  119.     End If
  120. Case 6
  121.     If PoRedu = 2 Then
  122.     Cifre = "Å¡ez"
  123.     Else
  124.     Cifre = "Å¡est"
  125.     End If
  126. Case 7
  127.     Cifre = "sedam"
  128. Case 8
  129.     Cifre = "osam"
  130. Case 9
  131.     If PoRedu = 2 Then
  132.     Cifre = "deve"
  133.     Else
  134.     Cifre = "devet"
  135.     End If
  136. End Select
  137. If PoRedu = 2 Then
  138.   If Cifra = 1 Then
  139.      Cifre = "naest"
  140.   Else
  141.      Cifre = Cifre & "deset"
  142.   End If
  143. ElseIf PoRedu = 3 Then
  144.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  145.     Cifre = Cifre & "stotine"
  146.     ElseIf Cifra = 1 Then
  147.     Cifre = "stotinu"
  148.     ElseIf Cifra = 0 Then
  149.     Else
  150.     Cifre = Cifre & "stotina"
  151.     End If
  152. End If
  153. Kraj:
  154. End Function
  155.  
  156. Function ImenaB(StrBr As String, Rod As Integer, PoRedu) As String
  157. Dim Cifra As Integer
  158. Dim Druga As Integer
  159.  
  160. If Val(StrBr) = 0 Then GoTo Kraj
  161. Cifra = Val(Right(StrBr, 1))
  162. If Len(StrBr) > 1 Then
  163. Druga = Val(Mid(StrBr, Len(StrBr) - 1, 1))
  164. End If
  165.  
  166. Select Case PoRedu
  167.  
  168. Case 1
  169. 'ništa
  170. Case 2
  171.    
  172.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  173.         If Druga = 1 Then
  174.         ImenaB = "hiljada"
  175.         Else
  176.         ImenaB = "hiljade"
  177.         End If
  178.     Else
  179.     ImenaB = "hiljada"
  180.     End If
  181. Case 3
  182.     If Cifra = 1 Then
  183.         If Druga = 1 Then
  184.         ImenaB = "miliona"
  185.         Else
  186.         ImenaB = "milion"
  187.         End If
  188.     Else
  189.     ImenaB = "miliona"
  190.     End If
  191. Case 4
  192.     If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  193.         If Druga = 1 Then
  194.         ImenaB = "milijardi"
  195.         Else
  196.         ImenaB = "milijarde"
  197.         End If
  198.     ElseIf Cifra = 1 Then
  199.         If Druga = 1 Then
  200.         ImenaB = "milijardi"
  201.         Else
  202.         ImenaB = "milijarda"
  203.         End If
  204.     Else
  205.     ImenaB = "milijardi"
  206.     End If
  207. Case 5
  208. End Select
  209. Kraj:
  210. End Function
  211. '*--------------------------------------broj slovima kraj-------------------------------------------------

Avko (28.10.2016 18:10):
Predmet: test vba kod
PreuzmiIzvorni kôd (Visual Basic):
  1. Function BrSlovima(Broj) As String
  2. '******************************************
  3. 'Ime:     BrSlovima Function
  4. 'Sadržaj: ispisuje broj tekstom
  5. 'Autor:     ZXZ
  6. 'Datum:      08 16, 2009, 12:34:16
  7. 'Adresa: Tuzla BiH
  8. 'Email:     izonic@inet.ba
  9. 'Ulazni parametri:broj
  10. 'Izlazni parametri:broj ispisan tekstom
  11. '*****************************************
  12. Dim I1 As Integer, I2 As Integer
  13. Dim N1 As Integer, N2 As Integer
  14. Dim DioTri As String
  15. Dim MjestoTri As Integer
  16. Dim RodJ As Integer
  17. Dim Strb As String
  18. Dim Cifra As Integer
  19. Dim Str(1 To 2) As String
  20.  
  21. 'Broj = 112
  22.  
  23. N1 = Fix(Len(Format$(Broj)) / 3)
  24. If Len(Format$(Broj)) Mod 3 > 0 Then
  25. N1 = N1 + 1
  26. End If
  27. For I1 = 1 To N1
  28.         If I1 = 3 Then
  29.         RodJ = 1
  30. Else
  31.         RodJ = 2
  32. End If
  33.  
  34. If I1 = N1 Then
  35.         MjestoTri = 1
  36.         N2 = Len(Format$(Broj)) Mod 3
  37.         If N2 = 0 Then: N2 = 3
  38.         Else
  39.                 N2 = 3
  40.                 MjestoTri = Len(Format$(Broj)) - I1 * 3 + 1
  41.         End If
  42.    
  43.         DioTri = Mid(Format$(Broj), MjestoTri, N2)
  44.         For I2 = 1 To N2
  45.                 Cifra = Mid(DioTri, N2 - I2 + 1, 1)
  46.                 If Cifra = 1 And Strb = "etiri" Then
  47.                         Strb = "etr"
  48.                 End If
  49.                 If Cifra = 1 And Strb = "Å¡est" Then
  50.                         Strb = "Å¡es"
  51.                 End If
  52.                 Str(1) = Cifre(Cifra, I2, I1)
  53.                 If Str(1) = "naest" And Str(2) = "jedan" Then
  54.                         Str(1) = "aest"
  55.                 End If
  56.                 If Str(1) = "nula" Then GoTo Petlja
  57.                 If Cifra = 1 And I2 = 2 Then
  58.                 If Str(2) = "nula" Then Str(1) = "deset"
  59.                         Strb = Strb & Str(1)
  60.                 Else
  61.                         Strb = Str(1) & Strb
  62.                 End If
  63.                 Petlja:
  64.                 Str(2) = Str(1)
  65.         Next I2
  66.    
  67.         BrSlovima = Strb & ImenaB(DioTri, RodJ, I1) & BrSlovima
  68.         Strb = ""
  69. Next I1
  70. End Function
  71.  
  72. Function Cifre(Cifra As Integer, PoRedu As Integer, Rod As Integer) As String
  73.  
  74. Select Case Cifra
  75.  
  76. Case 0
  77.         Cifre = "nula"
  78.         GoTo Kraj
  79. Case 1
  80.         If PoRedu = 1 Then
  81.                 If Rod = 1 Or Rod = 3 Or Rod = 5 Then
  82.                         Cifre = "jedan"
  83.                 Else
  84.                         Cifre = "jedna"
  85.                 End If
  86.         ElseIf PoRedu = 2 Then
  87.                 Cifre = "jeda"
  88.         End If
  89. Case 2
  90.         If PoRedu = 1 Or PoRedu = 3 Then
  91.                 If Rod = 1 Or Rod = 3 Or Rod = 5 Then
  92.                         Cifre = "dva"
  93.                 Else
  94.                         Cifre = "dvije"
  95.                 End If
  96.         ElseIf PoRedu = 2 Then
  97.                         Cifre = "dva"
  98.         End If
  99. Case 3
  100.         Cifre = "tri"
  101. Case 4
  102.         If PoRedu = 1 Or PoRedu = 3 Then
  103.                 Cifre = "etiri"
  104.         Else
  105.                 Cifre = "etr"
  106.         End If
  107. Case 5
  108.         If PoRedu = 2 Then
  109.                 Cifre = "pe"
  110.         Else
  111.                 Cifre = "pet"
  112.         End If
  113. Case 6
  114.         If PoRedu = 2 Then
  115.                 Cifre = "Å¡ez"
  116.         Else
  117.                 Cifre = "Å¡est"
  118.         End If
  119. Case 7
  120.         Cifre = "sedam"
  121. Case 8
  122.         Cifre = "osam"
  123. Case 9
  124.         If PoRedu = 2 Then
  125.                 Cifre = "deve"
  126.         Else
  127.                 Cifre = "devet"
  128.         End If
  129. End Select
  130. If PoRedu = 2 Then
  131.         If Cifra = 1 Then
  132.                 Cifre = "naest"
  133.         Else
  134.                 Cifre = Cifre & "deset"
  135.         End If
  136. ElseIf PoRedu = 3 Then
  137.         If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  138.                 Cifre = Cifre & "stotine"
  139.         ElseIf Cifra = 1 Then
  140.                 Cifre = "stotinu"
  141.         ElseIf Cifra = 0 Then
  142.         Else
  143.                 Cifre = Cifre & "stotina"
  144.         End If
  145. End If
  146. Kraj:
  147. End Function
  148.  
  149.  
  150. Function ImenaB(StrBr As String, Rod As Integer, PoRedu) As String
  151. Dim Cifra As Integer
  152. Dim Druga As Integer
  153.  
  154. If Val(StrBr) = 0 Then GoTo Kraj
  155. Cifra = Val(Right(StrBr, 1))
  156. If Len(StrBr) > 1 Then
  157. Druga = Val(Mid(StrBr, Len(StrBr) - 1, 1))
  158. End If
  159.  
  160. Select Case PoRedu
  161.  
  162. Case 1
  163. 'ništa
  164. Case 2
  165.         If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  166.                 If Druga = 1 Then
  167.                         ImenaB = "hiljada"
  168.                 Else
  169.                         ImenaB = "hiljade"
  170.                 End If
  171.         Else
  172.                 ImenaB = "hiljada"
  173.         End If
  174. Case 3
  175.         If Cifra = 1 Then
  176.                 If Druga = 1 Then
  177.                         ImenaB = "miliona"
  178.                 Else
  179.                         ImenaB = "milion"
  180.                 End If
  181.         Else
  182.                 ImenaB = "miliona"
  183.         End If
  184. Case 4
  185.         If Cifra = 2 Or Cifra = 3 Or Cifra = 4 Then
  186.                 If Druga = 1 Then
  187.                         ImenaB = "milijardi"
  188.                 Else
  189.                         ImenaB = "milijarde"
  190.                 End If
  191.         ElseIf Cifra = 1 Then
  192.                 If Druga = 1 Then
  193.                         ImenaB = "milijardi"
  194.                 Else
  195.                         ImenaB = "milijarda"
  196.                 End If
  197.         Else
  198.                 ImenaB = "milijardi"
  199.         End If
  200. Case 5
  201.         End Select
  202. Kraj:
  203. End Function
  204. '*--------------------------------------broj slovima kraj-------------------------------------------------

Kontakt
Sva vremena su GMT +01:00. Trenutno vrijeme: 5: 13 am.