Tema
Registracija

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

Odgovori Nova tema
Štampanje RSS teme Kopiraj vezu do teme Idi na poslednju poruku
  • 40 odgovora
  • 34.754 pregleda
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 13.03.2013. u 21:52 · pre 165 meseci #26
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.
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 15.03.2013. u 10:28 · pre 165 meseci #29
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]
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 15.03.2013. u 19:43 · pre 165 meseci #30
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).
Potpis
ER
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 16.03.2013. u 16:33 · pre 165 meseci #32
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.
Potpis
ER
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 19.03.2014. u 01:34 · pre 153 meseci #35
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]
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 19.03.2014. u 07:57 · pre 153 meseci #36
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
Potpis
[email protected]=
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 17.03.2016. u 17:53 · pre 129 meseci #38
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]
broj_slovima_ukune.xlsm30.57k
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 18.03.2016. u 07:26 · pre 129 meseci #39
Možda da prosto izmeniš u izvoru svako pominjanje "jedan" u "jedna".
Potpis
Have you found helpful examples, solutions or ideas-in-work, please consider the
following:
• Citation of *actual page* you are going to using is welcome.
• Have you saw "Value Added" examples you are going to incorporate to your
profitable blog, daily job or any money making venture: How about online donation?
↗Ana & Vlade Divac Foundation
Hvala!
Re: [Excel] Promjena makroa za ispisivanje brojeva slovima. How? 18.03.2016. u 17:08 · pre 129 meseci #40
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
Odgovori
Prijavite se da biste odgovorili u ovoj temi.PrijavaRegistracija

Premeštanje teme