Predmet:Re: test vba kod
I ja sam nekad napravio tu funkciju, davnoooo
PreuzmiIzvorni kôd (Visual Basic):Function SlovimA(broj As Single)
Dim rez As String, Cjeli As Integer, Dec As Single, CBroj As String
Dim Duzina As Integer, i As Integer, Tric As String, cs As Integer, cj As Integer, cd As Integer
Dim dDec As String, Slov As String
Dim ImeBr(9) As String
On Error GoTo Greska
broj = Trim(broj)
If (broj = 0) Then
SlovimA = "nula"
Exit Function
End If
ImeBr(1) = "jedan"
ImeBr(2) = "dva"
ImeBr(3) = "tri"
ImeBr(4) = "
etiri"
ImeBr(5) = "pet"
ImeBr(6) = "šest"
ImeBr(7) = "sedam"
ImeBr(8) = "osam"
ImeBr(9) = "devet"
rez = ""
Cjeli = Int(broj)
Dec = (broj - Cjeli) * 100
CBroj = Trim(Str(Cjeli)) ', 15)
Duzina = Len(CBroj)
CBroj = Space$(15 - Duzina) & CBroj
i = 1
Do While (i < 15)
Tric = Mid(CBroj, i, 3)
If (Tric <> " " And (Tric <> "001" Or i = 4)) Then
cs = Val(Mid(Tric, 1, 1))
cd = Val(Mid(Tric, 2, 1))
cj = Val(Mid(Tric, 3, 1))
If (cs = 1) Then
rez = rez + "sto"
ElseIf (cs = 2) Then
rez = rez + "dvije"
ElseIf (cs > 2) Then
rez = rez + ImeBr(cs)
End If
If (cs > 4) Then
rez = rez + "stotina"
ElseIf (cs > 1) Then
rez = rez + "stotine"
End If
Select Case cd
Case 4
rez = rez + "
etr"
Case 5
rez = rez + "pe"
Case 6
rez = rez + "šez"
Case 9
rez = rez + "deve"
Case Is > 1
rez = rez + ImeBr(cd)
Case 1
If (cj = 0) Then
rez = rez + "deset"
ElseIf (cj = 1) Then
rez = rez + "jeda"
ElseIf (cj = 4) Then
rez = rez + "
etr"
Else
rez = rez + ImeBr(cj)
End If
If (cj > 0) Then
rez = rez + "naest"
End If
Case Else
End Select
If (cd > 1) Then
rez = rez + "deset"
End If
If (cd <> 1 And cj <> 0 And (i = 13 Or Val(Tric) <> 1)) Then
If (cj = 2 And i <> 13 And i <> 7) Then
rez = rez + "dvije"
Else
rez = rez + ImeBr(cj)
End If
End If
If ((i = 1 Or i = 10) And cs + cd + cj <> 0) Then
rez = rez + "hiljad"
If (Val(Tric) = 1) Then
rez = rez + "u"
ElseIf (cj > 4 Or cj = 0) Then
rez = rez + "a"
ElseIf (cj > 1) Then
rez = rez + "e"
End If
ElseIf (i = 4 And cs + cd + cj <> 0) Then
rez = rez + "milijard"
If (Val(Tric) = 1) Then
rez = rez + "u"
ElseIf (cj > 4 Or cj = 0) Then
rez = rez + "i"
ElseIf (cj > 1) Then
rez = rez + "e"
End If
ElseIf (i = 7 And cs + cd + cj <> 0) Then
rez = rez + "milion"
If (cj <> 1) Then
rez = rez + "a"
End If
End If
ElseIf (Tric = "001") Then
rez = rez + "jedan"
End If
i = i + 3
Loop
dDec = Str(Val(Dec)) ', 2)
Slov = rez + " " + dDec + "/100"
SlovimA = Slov
Exit Function
Greska:
SlovimA = "NEIZRECIVO"
End Function