Prikazi cijelu temu 28.10.2016 19:26
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


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-------------------------------------------------
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.