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

Slobodan Trebovac
Banja Luka

Član broj: 40266
Poruke: 1070
*.teol.net.

Profil

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

^{05.01.2006. u 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]}

tyranBL

^{05.01.2006. u 11:40}

Jpeca
Predrag Jovanović
Božic i sinovi - škola računara
Pančevo

Moderator
Član broj: 25683
Poruke: 1124
212.200.27.*

Jabber: jpeca@elitesecurity.org

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{05.01.2006. u 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"

Dva u dva ide jednom ako možeš da ga ućuškaš

^{05.01.2006. u 13:30}

Slobodan Trebovac
Banja Luka

Član broj: 40266
Poruke: 1070
*.teol.net.

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{07.01.2006. u 00:37}

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

tyranBL

^{07.01.2006. u 00:37}

7DaDo7

Član broj: 47388
Poruke: 17
*.net.t-com.hr.

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{29.03.2006. u 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

^{29.03.2006. u 11:20}

Jpeca
Predrag Jovanović
Božic i sinovi - škola računara
Pančevo

Moderator
Član broj: 25683
Poruke: 1124
212.200.27.*

Jabber: jpeca@elitesecurity.org

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{29.03.2006. u 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.

Dva u dva ide jednom ako možeš da ga ućuškaš

^{29.03.2006. u 12:13}

7DaDo7

Član broj: 47388
Poruke: 17
*.net.t-com.hr.

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{29.03.2006. u 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

^{29.03.2006. u 13:08}

7DaDo7

Član broj: 47388
Poruke: 17
*.net.t-com.hr.

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{29.03.2006. u 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

^{29.03.2006. u 13:25}

Jpeca
Predrag Jovanović
Božic i sinovi - škola računara
Pančevo

Moderator
Član broj: 25683
Poruke: 1124
212.200.27.*

Jabber: jpeca@elitesecurity.org

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{29.03.2006. u 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

Dva u dva ide jednom ako možeš da ga ućuškaš

^{29.03.2006. u 14:32}

7DaDo7

Član broj: 47388
Poruke: 17
*.adsl.net.t-com.hr.

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{29.03.2006. u 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

^{29.03.2006. u 18:30}

7DaDo7

Član broj: 47388
Poruke: 17
*.adsl.net.t-com.hr.

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{29.03.2006. u 18:42}

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

Jos jednom - hvala ti puno.

^{29.03.2006. u 18:42}

7DaDo7

Član broj: 47388
Poruke: 17
*.net.t-com.hr.

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{30.03.2006. u 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?

^{30.03.2006. u 07:46}

Jpeca
Predrag Jovanović
Božic i sinovi - škola računara
Pančevo

Moderator
Član broj: 25683
Poruke: 1124
212.200.27.*

Jabber: jpeca@elitesecurity.org

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{30.03.2006. u 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.

Dva u dva ide jednom ako možeš da ga ućuškaš

Prikačeni fajlovi

slovima.xls - 35k

^{30.03.2006. u 15:16}

7DaDo7

Član broj: 47388
Poruke: 17
*.net.t-com.hr.

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{31.03.2006. u 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.

^{31.03.2006. u 06:18}

Jpeca
Predrag Jovanović
Božic i sinovi - škola računara
Pančevo

Moderator
Član broj: 25683
Poruke: 1124
212.200.27.*

Jabber: jpeca@elitesecurity.org

Profil

Re: Promjena makroa za ispisivanje brojeva slovima. How?

^{31.03.2006. u 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.

Dva u dva ide jednom ako možeš da ga ućuškaš

^{31.03.2006. u 07:31}

VralE
Jande Jo
Bojdo

Član broj: 39992
Poruke: 1
*.teol.net.

Profil

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

^{27.03.2008. u 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

^{27.03.2008. u 09:16}