[Excel] Promjena makroa za ispisivanje brojeva slovima. How?

[Excel] Promjena makroa za ispisivanje brojeva slovima. How? 05.01.2006. u 11:40 · pre 253 meseci #1

Nedavno sam na sajtu http://www.praktikum.co.yu/ pronasao makro za Excel napisan u VBA koji upisani broj pretvara u slova. Navedeno je da makro radi radi u svim verzijama Excela pocev od Excela 5 do Excela 2000. Posto u vrijeme kada je to objavljeno vjerovatno nisu postojale novije verzije ja sam provjerio i na novijim verzijama Excela i navedeni makro radi i na njima, zakljucno sa Excel-om 2003. Makro radi besprijekorno. E sad ja hocu da malo izmijenim rezultat koji daje makro, ali posto sam jos uvijek na vi sa VBA, zamolio bih nekoga ko zna da pokusa da malo izmijeni kod makro-a da bi davao rezultat koji bih ja zelio, a mislim da je to veoma koristan makro koji moze koristiti mnogima.
Znaci, VBA makro daje ovakav rezultat:
npr.
dvijestotinesedamdesetpet 14/100

a mene interesuje da li moze ovako:
Dvijestotinesedamdesetpet i 14/100 DIN

Evo dajem i makro:

Code:

Function slovima(broj)

If broj = 0 Then rez = "nula"

ReDim imebr(9)
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 = ""
celi = Int(broj)
dec = ((broj - celi) * 100) Mod 100
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 & "č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 & "č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 (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

slovima = rez & Str(dec) & "/100"

End Function

I jos me jedna stvar interesuje, kako natjerati makro da prikazuje slovo č jer umjesto četiri on napise cetiri.
Hvala.

_{[Ovu poruku je menjao Shadowed dana 13.05.2006. u 18:48 GMT+1]}

Potpis

tyranBL

Re: Promjena makroa za ispisivanje brojeva slovima. How? 05.01.2006. u 13:30 · pre 253 meseci #2

Zameni poslednji red (iza Loop) sa sledećim:

rez = UCase(Left(rez, 1)) & Right(rez, Len(rez) - 1)
slovima = rez & Str(dec) & "/100" & " DIN"

Što ste tiče problema sa č nisam siguran da to nije radilo i ovako - koristio sam i sam ovu funkciju, ali može se staviti ChrW(269) dakle izmeni redove

imebr(4) = ChrW(269) + "etiri"

i ispod Case 4:

rez = rez & ChrW(269) + "etr"

Potpis

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Re: Promjena makroa za ispisivanje brojeva slovima. How? 07.01.2006. u 00:37 · pre 253 meseci #3

To je to, sad je sve kao sto ja zelim.
Hvala.

Potpis

tyranBL

Re: Promjena makroa za ispisivanje brojeva slovima. How? 29.03.2006. u 11:20 · pre 250 meseci #4

Moze jos jedna mala dorada:

Kako napraviti da se prikazuje: "Dvijestotinesedamdesetpet i 00/100 DIN" ? Znaci ako je iznos 275,00 DIN da dobijem prethodno navedeni ispis?
Hvala

Re: Promjena makroa za ispisivanje brojeva slovima. How? 29.03.2006. u 12:13 · pre 250 meseci #5

Ako umesto funkcije str(dec) napišeš format(dec, "00")
dobićeš to što želiš i svi jednocifreni iznosi pisaće se sa 0 ispred -- 05/100 umesto 5/100 itd.

Potpis

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Re: Promjena makroa za ispisivanje brojeva slovima. How? 29.03.2006. u 13:08 · pre 250 meseci #6

Odlicno, hvala.

Jos me zanima kako da, kada se upise 0,15 DIN iznos ispise kao: nula DIN i 15/100?

A jel' mozda znas i imas vremena doraditi taj kod da se i te pare ispisuju slovima?

Hvala jos jednom

Re: Promjena makroa za ispisivanje brojeva slovima. How? 29.03.2006. u 13:25 · pre 250 meseci #7

Citat:

Jos me zanima kako da, kada se upise 0,15 DIN iznos ispise kao: nula DIN i 15/100?

Ovo sam rjesio.

Ako mozes/stignes ono drugo .. :)

Hvala

Re: Promjena makroa za ispisivanje brojeva slovima. How? 29.03.2006. u 14:32 · pre 250 meseci #8

Da ne bi mnogo brljao postojeci kod (usput iako ovde nije navedeno kod je ' beerware' - vidi sajt praktikum.co.yu) napravio sam novu funkciju, koju treba dodati umesto format - slovima = rez & "dinara i " & slovimapare(dec). Nova funkcija koristi istu logiku.

Code:

Function slovimapare(broj) As String
' konvertuje broj do 99 u tekst

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"
  End If
  slovimapare = rez

Kraj:
End Function

Potpis

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Re: Promjena makroa za ispisivanje brojeva slovima. How? 29.03.2006. u 18:30 · pre 250 meseci #9

Molim te malo pojasnjenje: da li tu funkciju kopiram u isti modul iza Loop pa na kraju dodam ono slovima = rez & "dinara i " & slovimapare(dec) ili ju kopiram u novi modul ili nesto trece?

Hvala

Re: Promjena makroa za ispisivanje brojeva slovima. How? 29.03.2006. u 18:42 · pre 250 meseci #10

Ma sve OK. Insertirao sam novi Modul, a u prethodnom iymjenio red sa slovima ......

Jos jednom - hvala ti puno.

Re: Promjena makroa za ispisivanje brojeva slovima. How? 30.03.2006. u 07:46 · pre 250 meseci #11

Jos jedno pitanje:

Testirajuci malo ovu funkciju primjetio sam da kada se upise npr. -0,25 rezultat je nula dinara i dvije pare umjesto dvadesetpet para

Imas li rjesenje za ovaj problem?

Re: Promjena makroa za ispisivanje brojeva slovima. How? 30.03.2006. u 15:16 · pre 250 meseci #12

Kod mene radi OK za pozitivne brojeve npr 0.25 dobija se nuladinaraidvadesetpetpara.
Za negativne brojeve ovo ne radi. Znači prethodno ispitaj da li je negativa pa ga pretvori u pozitivan i dodaj neki tekst direktno u Excelu - ne treba da menjaš makro.

Potpis

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

slovima.xls35k

Re: Promjena makroa za ispisivanje brojeva slovima. How? 31.03.2006. u 06:18 · pre 250 meseci #13

Nazalost meni to nije tako jednostavno /mislim na svoje (ne)znanje/ :(

Naime ona prva funkcija na neki (meni nepoznat) nacin ignorira predznak odnosno da li je broj pozitivan ili negativan jer ako upises 100,00 ili -100,00 dobije s rezultat "sto"
A meni bas upravo to i treba. Ove funkcije bi koristio na obrascu fakture, a s obzirom da ponekad moram raditi i storno fakture (iznosi kao i na racunu koji se stornira, ali svi negativni "-") iznos bi se neovisno o predznaku trebao ipravno ispisivati.

Jel' se moze to nekako napraviti i u tvojoj funkciji?

Hvala na trudu.

Re: Promjena makroa za ispisivanje brojeva slovima. How? 31.03.2006. u 07:31 · pre 250 meseci #14

Jednostavno u Excelu nemoj da direktno pozoveš funkciju slovima(iznos) nego:

Code:
=IF(B1>= 0;slovima(B1);slovima(-B1))

U prilogu koji sam prethodno poslao B1 sadrzi iznos, ti naravno promeni.

Potpis

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 27.03.2008. u 09:16 · pre 226 meseci #15

Evo prepravljena verzija na ijekavici i u konvertibilnim markama.

Code:

Function slovima(broj)

If broj = 0 Then rez = "nula"

ReDim imebr(9)
imebr(1) = "jedna"
imebr(2) = "dvije"
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
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 & "dvije"
   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
    rez = rez & "dva"
    Case 3, 7, 8
    rez = rez & imebr(cd)
   Case 1
    sl1 = ""
    Select Case cj
     Case 0
      rez = rez & "deset"
     Case 1
      rez = rez & "jeda"
     Case 2
      rez = rez & "dva"
     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 (i = 4 Or i = 10) And cd <> 1 Then
   If cj = 1 Then
    sl1 = "jedna"
   ElseIf cj = 2 Then
    sl1 = "dvije"
   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

slovima = rez & Format(dec, " i 00") & "/100" & " KM"

End Function

Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 24.08.2009. u 10:36 · pre 208 meseci #16

Dali nekoj, slucajno, go ima odraboteno ovoj cod na makedonski?

Pozz.

_{[Ovu poruku je menjao omega009 dana 25.08.2009. u 08:07 GMT+1]}

Potpis

What doesn't kill me, costs me money!

Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 28.09.2009. u 10:00 · pre 207 meseci #17

Eve ja verzijata na ovoj cod na makedonski jazik:

Code:

Function slovima(broj)

If broj = 0 Then rez = "nula"

ReDim imebr(9)
imebr(1) = "eden"
imebr(2) = "dva"
imebr(3) = "tri"
imebr(4) = "~etiri"
imebr(5) = "pet"
imebr(6) = "{est"
imebr(7) = "sedum"
imebr(8) = "osum"
imebr(9) = "devet"

rez = ""
celi = Int(broj)
dec = ((broj - celi) * 100) Mod 100
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 & "sto"
   Case 2
    rez = rez & "ste"
   Case 3
    rez = rez & "sta"
   Case 2, 3, 4
    rez = rez & "stotini"
   Case Is > 4
    rez = rez & "stotini"
  End Select

  If cj = 0 Then sl1 = "" Else sl1 = imebr(cj)

  Select Case cd
   Case 4
    rez = rez & "~etiri"
   Case 6
    rez = rez & "{e"
   Case 5
    rez = rez & "ped"
   Case 7
    rez = rez & "sedumd"
   Case 8
    rez = rez & "osumd"
   Case 9
    rez = rez & "deved"
   Case 2, 3, 7, 8
    rez = rez & imebr(cd)
   Case 1
    sl1 = ""
    Select Case cj
     Case 0
      rez = rez & "deset"
     Case 1
      rez = rez & "edi"
     Case 4
      rez = rez & "~etiri"
     Case Else
      rez = rez & imebr(cj)
    End Select
   If cj > 0 Then rez = rez & "naeset"
  End Select

  If cd > 1 Then rez = rez & "eseti"

  If (i = 4 Or i = 10) And cd <> 1 Then
   If cj = 1 Then
    sl1 = "edna"
   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 & "i"
    ElseIf cj > 4 Or cj = 0 Then
     rez = rez & "i"
    ElseIf cj > 1 Then
     rez = rez & "i"
    End If

   Case 7
    rez = rez & "milion"
    If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj <> 1 Then
     rez = rez & "i"
    End If

   Case 10
    rez = rez & "iljad"
    If ((trojka Mod 100) > 11 And (trojka Mod 100) < 9) Or cj = 1 Then
     rez = rez & "a"
    ElseIf trojka = 1 Then
     rez = rez & "i"
    ElseIf cj > 4 Or cj = 0 Then
     rez = rez & "i"
    ElseIf cj > 1 Then
     rez = rez & "i"
    End If

  End Select
End If
i = i + 3
Loop

slovima = rez & "den."

End Function

Potpis

What doesn't kill me, costs me money!

Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 28.09.2009. u 10:41 · pre 207 meseci #18

Proverite nešto malo brlja sa minusnim brojevima sa decimalama.
Pokušajte broj 111.11 i -111.11 videćete šta se dobija.
I kod drugih brojeva je isto.
Ovo sam proveravao u priloženom Excel fajlu.

Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 28.09.2009. u 11:48 · pre 207 meseci #19

Pogledaj malo iznad. Već je objašnjeno da funkcija za negativne brojeve ne radi i kako to možeš da prevaziđeš.

Potpis

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 30.09.2009. u 08:39 · pre 207 meseci #20

evo i verzije upotrebljive za fakture - iznos se ispisuje kao
"dvehiljade din i pet para", uz izbegavanje ispisa "nula para"

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
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 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

slovima = rez & " din " & slovimapare(dec)

End Function

Function slovimapare(broj) As String
' konvertuje broj do 99 u tekst

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 = ""
    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"
  End If
  slovimapare = " i " & rez

Kraj:
End Function

Potpis

od PRC-a glava ne boli
majstora je mnogo, jedan je drnesha & sinovi
P.S. PRC je Profesionalni Racunarski Centar

Srodne teme