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

[ Slobodan Trebovac @ 05.01.2006. 11:40 ] @

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

[ Jpeca @ 05.01.2006. 13:30 ] @

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"

[ Slobodan Trebovac @ 07.01.2006. 00:37 ] @

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

[ 7DaDo7 @ 29.03.2006. 11:20 ] @

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

[ Jpeca @ 29.03.2006. 12:13 ] @

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.

[ 7DaDo7 @ 29.03.2006. 13:08 ] @

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

[ 7DaDo7 @ 29.03.2006. 13:25 ] @

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

[ Jpeca @ 29.03.2006. 14:32 ] @

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

[ 7DaDo7 @ 29.03.2006. 18:30 ] @

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

[ 7DaDo7 @ 29.03.2006. 18:42 ] @

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

Jos jednom - hvala ti puno.

[ 7DaDo7 @ 30.03.2006. 07:46 ] @

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?

[ Jpeca @ 30.03.2006. 15:16 ] @

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.

[ 7DaDo7 @ 31.03.2006. 06:18 ] @

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.

[ Jpeca @ 31.03.2006. 07:31 ] @

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.

[ VralE @ 27.03.2008. 09:16 ] @

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

[ omega009 @ 24.08.2009. 10:36 ] @

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

[ omega009 @ 28.09.2009. 10:00 ] @

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

[ mld @ 28.09.2009. 10:41 ] @

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.

[ Jpeca @ 28.09.2009. 11:48 ] @

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

[ drnesha @ 30.09.2009. 08:39 ] @

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

[ azzo-kSv @ 28.12.2010. 12:26 ] @

Jpeca,
Ja napravim sve isto kao sto kazes, ali mi stalno izlazi: #NAME?
Gdje sam pogrijesio?
Hvala!

_{[Ovu poruku je menjao azzo-kSv dana 28.12.2010. u 13:42 GMT+1]}

[ neptuncokg @ 28.12.2010. 16:33 ] @

Jes da nisam Peca, ali sam Predrag. Funkcija "SlovimaPARE" treba da bude u modulu, a ne u sheetu. Evo pogledaj u primeru-2. Pozdrav

[ azzo-kSv @ 29.12.2010. 12:35 ] @

Pedja,
Nisam stigao da sve pogledam. Vidio sam na brzinu, da stalno izbacuje "para". To cu, kad budem stigao da probam prevesti na euro, ako budem znao.
Hvala ti!!

[ pondeke @ 13.03.2013. 20:22 ] @

da nema ko slucajno kod za eure, jos kad bi mogla varijanta gdje je na primjer 1500,50e - hiljadupetstotinaeurai50/100, unaprijed zahvalan.

[ srdrazic @ 13.03.2013. 20:48 ] @

Možda ti ovo pomogne..

[ pondeke @ 13.03.2013. 21:52 ] @

srdrazic tnx za primjer, kod na prvoj stranici mi odgovara i uspio sam da prepravim za eure, jedino ne uspijevam da na kraj dobijem ovo → i 50/100eur, 50/100eur imam ali mi fali slovo i ? Interesuje me i kako da trajno snimim kod u excel dokument ? kliknuo sam na ono record macro, kad sam pokrenuo excel ponovo, makroa vise nije bilo, morao sam ponovo da ga ubacim.

[ srdrazic @ 14.03.2013. 16:52 ] @

Evo ovako ;-)
Nije onako kako si mislio ali završava posao...

[ FOX028 @ 14.03.2013. 20:10 ] @

Da li mozda odgovara ovako nesto, makro pozivas kao funkciju a sintaksa je =slovima(polje sa iznosom)

[ pondeke @ 15.03.2013. 10:28 ] @

srdrazic hvala na trudu jos jednom, za moja dokumenta vise mi odgovara ovo sto je FOX028 odradio. FOX028 to je bas ono sto mi treba, samo jos ako moze rezultat na latinicu? Ako smijem rec, dobro bi bilo da ako imamo 1850eur pise samo hiljaduosamstotinapedeseteura bez 00/100.

_{[Ovu poruku je menjao pondeke dana 15.03.2013. u 11:47 GMT+1]}

_{[Ovu poruku je menjao pondeke dana 15.03.2013. u 11:48 GMT+1]}

[ EmmaR @ 15.03.2013. 19:43 ] @

Malo izmenjeni kodovi sa sajta praktikum.rs (D. Grbić):

latinica

Code:

Function slovima(broj)

Dim Dinari As String

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 & "šest"
   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

If rez = "" Then
   rez = "nula"
End If

If Right(rez, 5) = "jedan" Then
   Dinari = "dinar"
Else
   Dinari = "dinara"
End If

If dec < 10 Then
   slovima = rez & Dinari & " i " & "0" & Trim(Str(dec)) & "/100"
Else
    slovima = rez & Dinari & " i " & Str(dec) & "/100"
End If

End Function

latinica - eur

Code:

Function slovimaEUR(broj)

Dim evro As String

If broj = 0 Then rez = "nula"

ReDim imebr(9)
imebr(1) = "jedan"
imebr(2) = "dva"
imebr(3) = "tri"
' racunar nije nikako hteo da prihvati slovo č, pa je moralo ovako
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 & "šest"
   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

If rez = "" Then
   rez = "nula"
End If

If Right(rez, 5) = "jedan" Then
   evro = "eur"
Else
   evro = "eura"
End If

If dec < 10 Then
   slovimaEUR = rez & evro & " i " & "0" & Trim(Str(dec)) & "/100"
Else
    slovimaEUR = rez & evro & " i " & Str(dec) & "/100"
End If

End Function

pa, ako nekome koristi. Ako treba ćirilica: ono što se ispisuje ispisati ćirilicom, a za "specijalne" znake (č,ć,lj,nj,ž) naći odgovarajući ChrW kod (može da se vidi iz special character)

Npr:

Code:

If Right(rez, 5) = "jedan" Then
evro = "eur"
Else
evro = "eura"
End If

bi bilo

Code:
If Right(rez, 5) = "jedan" Then
evro = "eur"
Else
evro = "eura"
End If

Inače, kod se smešta u module (kao što je već rečeno), a ako treba da je dostupan u svim excel dokumentima onda ga smestiti u .xla datoteci koja se smesta u odgovarajuci direktorijum (pronaci gde vec postoji "sistemska" excel .xla datoteka).

[ pondeke @ 16.03.2013. 02:31 ] @

EmmaR ovo sto si postavio kod mene neshto nece ....

[ EmmaR @ 16.03.2013. 16:33 ] @

Citat:

pondeke: EmmaR ovo sto si postavio kod mene neshto nece ....

Koji deo? Funkcije (latinične verzije) kod mene rade.

Zaboravila sam da napišem da .xla datoteka se uključuje kao proširenje Excel-a (Add-Ins ... potražiti među opcijama za podešavanje Excel-a).

----
P.S. Postoji i varijanta oko podešavanja Personal.xls datoteke (ako ne postoji, napravi se u startnom direktorijumu Excela) ali meni to nije odgovaralo ... ubacuje se u module te datoteke i onda ne treba da se dodatno uključuje kao proširenje ali hoće posle da dosađuje sa upozorenjem o postojanju makroa.

[ FOX028 @ 16.03.2013. 19:37 ] @

Evo ispravljenog koda, sada moze i Cirilica =CirSlovima i Latinica =LatSlovima

[ pondeke @ 17.03.2013. 01:02 ] @

Svaka cast doktore, to je to.

[ nibana @ 19.03.2014. 01:34 ] @

Prevnstveno želim da Vam se zahvalim za Vaš uloženi trud i želju da pomognete nama koji ovu oblast nepoznajemo!
Pokrenuo sam Makro! Radi!!!
Kako podesiti makro da kada su decimale 00 da ne ispisuje 00/100? I kako podesiti da kada je 0,15 ispisuje "nula i 15/100"?

Ovo je macro koji koristim!

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) = ChrW(353) + "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 & ChrW(353) + "est"
   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

rez = UCase(Left(rez, 1)) & Right(rez, Len(rez) - 1)
slovima = rez & " i " & Format(dec, "00") & "/100" & " KM"

End Function

Neizmjerno sam Vam zahvalan!

_{[Ovu poruku je menjao nibana dana 19.03.2014. u 03:02 GMT+1]}

[ FOX028 @ 19.03.2014. 07:57 ] @

Ubaci ovaj kod, trebalo bi da je ovo to sto ti je potrebno

Code:
Function slovima(broj)

If broj = 0 Then rez = "nula"

ReDim imebr(10)
imebr(1) = "jedna"
imebr(2) = "dvije"
imebr(3) = "tri"
imebr(4) = ChrW(269) + "etiri"
imebr(5) = "pet"
imebr(6) = ChrW(353) + "est"
imebr(7) = "sedam"
imebr(8) = "osam"
imebr(9) = "devet"
imebr(10) = "nula"

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 & ChrW(353) + "est"
   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

If celi = 0 Then rez = imebr(10)

rez = UCase(Left(rez, 1)) & Right(rez, Len(rez) - 1)

If dec = 0 Then
    slovima = rez & " KM"
Else
    slovima = rez & " i " & Format(dec, "00") & "/100" & " KM"
End If

End Function

[ nibana @ 19.03.2014. 19:01 ] @

Hvala puno!!!

[ brko @ 17.03.2016. 17:53 ] @

Da li mi netko može pomoći. Pošto je kuna ženskog roda kad se u jedinicama piše broj jedan da ne ispiše u muškom rodu.
Sve drugo radi osim ako je broj jedan, dva, tri.četiri ( desetica )
npr.

Code:

1,00    slovima: jedan kuna i nula lipa
2,00    slovima: dva kuna i nula lipa
3,00    slovima: tri kuna i nula lipa
4,00    slovima: četiri kuna i nula lipa
1,01    slovima: jedan kuna i jedna lipa
501,01    slovima: petstojedan kuna i jedna lipa

Hvala

_{[Ovu poruku je menjao brko dana 17.03.2016. u 21:42 GMT+1]}

_{[Ovu poruku je menjao brko dana 17.03.2016. u 21:43 GMT+1]}

[ 3okc @ 18.03.2016. 07:26 ] @

Možda da prosto izmeniš u izvoru svako pominjanje "jedan" u "jedna".

[ brko @ 18.03.2016. 17:08 ] @

Hvala na odgovoru ali onda postoji problem sa milion
1.100.000,00 gdje trebam "jedan" -> jedan milionstotisuća kuna i nula lipa
Također bi trebalo mijenjati padeže; nominativ "kuna" u genitiv "kune" kao što lijepo radi sa lipama
1 kuna
2 kune
3 kune
4 kune

[ 3okc @ 19.03.2016. 13:54 ] @

Sličan problem ali sa ispisom radnog staža, gde se reči Godina, Mesec i Dan menjaju u zavisnosti od broja, bio sam rešio jednostavnom tabelom u kojoj su samo one jedinične vrednosti kada dolazi do promene. Pogledaj Računanje radnog staža, možda pomogne.