Słownie złotych w Excelu

[k***@interia.pl]

Niedawno znalazłem bardzo dobry przykład "Słownie złotych" w Excelu w
następującym formacie: np. sto pięćdziesiąt zł dwadzieścia gr. Po
sformatowaniu dysku straciłem to makro z VBA dla Excela. Spodobał mi
się ten sposób i tu mam do Was pytanie czy ktoś posiada takie makro
dla Excela i mógłby mi podrzucić. Byłbym ogromnie wdzięczny. Pozdrawiam

[Jacek]

Sub NapiszSłownie()

slownie = ""
kwota = Range("kwota")
reszta = kwota - Fix(kwota)
reszta = reszta * 100
r = reszta
il_tys = Int(kwota / 1000)
If il_tys > 0 Then
Call slow((il_tys))
slownie = slownie + " tys. "
End If
il_setek = kwota - il_tys * 1000
If il_setek > 0 Then
Call slow((il_setek))
slownie = slownie
End If
If reszta > 0 Then
If Int(kwota) > 0 Then
slownie = slownie + " zł. "
Else
slownie = slownie + "zero zł. "
End If
Call slow((r))
slownie = slownie + " gr."
Range("słownie") = slownie
Else
If Int(kwota) > 0 Then
slownie = slownie + " zł. "
Else
slownie = slownie + "zero zł. "
End If
slownie = slownie + " zero gr."
Range("słownie") = slownie
End If

End Sub

Sub slow(ala As Single)
Dim setki(9)
Dim dzie(11)
Dim jed(19)
jed(1) = "jeden"
jed(2) = "dwa"
jed(3) = "trzy"
jed(4) = "cztery"
jed(5) = "pięć"
jed(6) = "sześć"
jed(7) = "siedem"
jed(8) = "osiem"
jed(9) = "dziewięć"
jed(10) = "dziesięć"
jed(11) = "jedenaście"
jed(12) = "dwanaście"
jed(13) = "trzynaście"
jed(14) = "czternaście"
jed(15) = "piętnaście"
jed(16) = "szesnaście"
jed(17) = "siedemnaście"
jed(18) = "osiemnaście"
jed(19) = "dziewiętnaście"

dzie(1) = "dziesięć"
dzie(2) = "dwadzieścia"
dzie(3) = "trzydzieści"
dzie(4) = "czterdzieści"
dzie(5) = "pięćdziesiąt"
dzie(6) = "sześćdziesiąt"
dzie(7) = "siedemdziesiąt"
dzie(8) = "osiemdziesiąt"
dzie(9) = "dziewięćdziesiąt"

setki(1) = "sto"
setki(2) = "dwieście"
setki(3) = "trzysta"
setki(4) = "czterysta"
setki(5) = "pięćset"
setki(6) = "sześćset"
setki(7) = "siedemset"
setki(8) = "osiemset"
setki(9) = "dziewięćset"

s = Fix(ala / 100)
d = Fix((ala - s * 100) / 10)
j = Fix(ala - s * 100 - d * 10)
If s > 0 Then
slownie = slownie + setki(s) + " "
End If
If d = 1 Then
slownie = slownie + jed(Fix(ala) - s * 100)
Exit Sub
End If
If d >= 2 Then
slownie = slownie + dzie(d)
End If
If j > 0 Then
slownie = slownie + " " + jed(j)
End If
End Sub

[Grzegorz Danowski]

U?ytkownik <***@interia.pl> napisa? w wiadomo?ci news:***@22g2000hsm.googlegroups.com...
<cite>
Niedawno znalazłem bardzo dobry przykład "Słownie złotych" w Excelu w
następującym formacie: np. sto pięćdziesiąt zł dwadzieścia gr. Po
sformatowaniu dysku straciłem to makro z VBA dla Excela. Spodobał mi
się ten sposób i tu mam do Was pytanie czy ktoś posiada takie makro
dla Excela i mógłby mi podrzucić. Byłbym ogromnie wdzięczny. Pozdrawiam
</cite>

Jeśli potrzebujesz kodu nieco bardziej uniwersalnego, także dla kwot powyżej
miliona, to może się przyda mój stary kawałek:
http://www.gdnkonsulting.waw.pl/index_pliki/SlownieZl.htm
Jeśli nie, to na Pozorkowni znajdziesz inne wersje.
--
Pozdrawiam
Grzegorz

[k***@interia.pl]

Post by k***@interia.pl
Niedawno znalazłem bardzo dobry przykład "Słownie złotych" w Excelu w
następującym formacie: np. sto pięćdziesiąt zł dwadzieścia gr. Po
sformatowaniu dysku straciłem to makro z VBA dla Excela. Spodobał mi
się ten sposób i tu mam do Was pytanie czy ktoś posiada takie makro
dla Excela i mógłby mi podrzucić. Byłbym ogromnie wdzięczny. Pozdrawiam

Jacek
Czy ten Twój kod "Sub NapiszSłownie()" jest kompletny. Próbuję go
zastosować i wyświetla mi to "#NAZWA?". Odnoszę wrażenie (może mylne),
że jest niekompletny. Masz jakiś pomysł w tej kwestii? Będę wdzięczny
za odpowiedź i podpowiedź. Pozdrawiam
Krzysztof

[Jacek]

Post by k***@interia.pl

Post by k***@interia.pl
Niedawno znalazłem bardzo dobry przykład "Słownie złotych" w Excelu w
następującym formacie: np. sto pięćdziesiąt zł dwadzieścia gr. Po
sformatowaniu dysku straciłem to makro z VBA dla Excela. Spodobał mi
się ten sposób i tu mam do Was pytanie czy ktoś posiada takie makro
dla Excela i mógłby mi podrzucić. Byłbym ogromnie wdzięczny. Pozdrawiam

Jacek
Czy ten Twój kod "Sub NapiszSłownie()" jest kompletny. Próbuję go
zastosować i wyświetla mi to "#NAZWA?". Odnoszę wrażenie (może mylne),
że jest niekompletny. Masz jakiś pomysł w tej kwestii? Będę wdzięczny
za odpowiedź i podpowiedź. Pozdrawiam
Krzysztof

Jest kompletny ale odwoluje sie do komorki nazwanej "kwota". W polu, gdzie
jest wyswietlany adres komorki wpisujesz kwota i bedzie dzialac,
ewentualnie popraw sobie linijki: kwota = Range("kwota").

[Jacek]

P.S. Jest jeszcze komorka o nazwie słownie, wiec to musisz
uwzglednic/poprawic.

[pxd74]

Post by k***@interia.pl
Niedawno znalazłem bardzo dobry przykład "Słownie złotych" w Excelu w
następującym formacie: np. sto pięćdziesiąt zł dwadzieścia gr. Po
sformatowaniu dysku straciłem to makro z VBA dla Excela. Spodobał mi
się ten sposób i tu mam do Was pytanie czy ktoś posiada takie makro
dla Excela i mógłby mi podrzucić. Byłbym ogromnie wdzięczny. Pozdrawiam

Tutaj masz funckję dla Excela wraz z informacją jak zainstalować dodatek
zawierający tą funckję arkusza:
http://www.excel.republika.pl/dopobrania/slownie.htm

[Szymon Nowak]

Post by k***@interia.pl
Niedawno znalazłem bardzo dobry przykład "Słownie złotych" w Excelu w
następującym formacie: np. sto pięćdziesiąt zł dwadzieścia gr. Po
sformatowaniu dysku straciłem to makro z VBA dla Excela. Spodobał mi
się ten sposób i tu mam do Was pytanie czy ktoś posiada takie makro
dla Excela i mógłby mi podrzucić. Byłbym ogromnie wdzięczny. Pozdrawiam

ja sobie kiedyś napisałem takie cudo

Option Explicit
Dim sto As Single
Dim dziesiec As Single
Dim jeden As Single
Dim stoslownie As String
Dim dziesiecslownie As String
Dim jedenslownie As String
Dim xxxslownie As String
Dim jedynki As String
Dim tysiace As String
Dim miliony As Single
Dim miliardy As Single
Dim biliony As Single
Dim liczba As String
Dim liczcałk As String
Dim słliczcałk As String
Dim sljedynki As String
Dim sltysiace As String
Dim slmiliony As String
Dim slmiliardy As String
Dim slbiliony As String
Dim grosze As String
Dim waluta As String
Dim optysiecy As String
Dim opmilionow As String
Dim opmiliardow As String
Dim opbilionow As String
Dim dziesiecsamo As String
Dim i As Single

Function Slownie(a As Double, Optional b As Boolean = True) As String

If a = Round(a, 0) Then
liczba = a
liczcałk = a
If b = True Then
grosze = " 0/100"
Else
grosze = ""
End If

Else
liczba = Format(Round(a, 2), "#.00")
liczcałk = liczba - Right(liczba, 3)
If b = True Then
grosze = " " & Right(liczba, 2) & "/100"
Else
If Right(liczba, 2) = "01" Then
grosze = " i 1 grosz"
ElseIf Right(liczba, 2) = "11" Or Right(liczba, 2) = "12" Or
Right(liczba, 2) = "13" Or Right(liczba, 2) = "14" Or Right(liczba, 2)
= "15" Or Right(liczba, 2) = "16" Or Right(liczba, 2) = "17" Or
Right(liczba, 2) = "18" Or Right(liczba, 2) = "19" Then
grosze = " i " & Right(liczba, 2) & " groszy"
ElseIf Right(liczba, 2) = "02" Or Right(liczba, 2) = "03" Or
Right(liczba, 2) = "04" Then
grosze = " i " & Right(liczba, 1) & " grosze"
ElseIf Right(liczba, 1) = "2" Or Right(liczba, 1) = "3" Or
Right(liczba, 1) = "4" Then
grosze = " i " & Right(liczba, 2) & " grosze"
ElseIf Right(liczba, 2) = "05" Or Right(liczba, 2) = "06" Or
Right(liczba, 2) = "07" Or Right(liczba, 2) = "08" Or Right(liczba, 2)
= "09" Then
grosze = " i " & Right(liczba, 1) & " groszy"
Else
grosze = " i " & Right(liczba, 2) & " groszy"
End If
End If
End If

If liczcałk = 0 Then
Slownie = "zero złotych" & grosze
ElseIf liczcałk = 1 Then
Slownie = "jeden złoty" & grosze
Else

If Right(liczcałk, 2) > 10 And Right(liczcałk, 2) < 20 Then
waluta = " złotych"
GoTo nast
End If
If Right(liczcałk, 1) = 2 Or Right(liczcałk, 1) = 3 Or Right(liczcałk,
1) = 4 Then
waluta = " złote"
Else
waluta = " złotych"
End If
nast:
jedynki = Right(liczcałk, 3)
tysiace = (Right(liczcałk, 6) - jedynki) / 1000
miliony = (Right(liczcałk, 9) - jedynki - tysiace * 1000) / 1000000
miliardy = (Right(liczcałk, 12) - jedynki - tysiace * 1000 - miliony *
1000000) / 1000000000
biliony = Round((liczcałk / 1000000000000# - miliardy /
1000000000000#), 0)

If jedynki <> 0 Then
znajdz (jedynki)
sljedynki = xxxslownie
Else
sljedynki = ""
End If
If tysiace <> 0 Then
znajdz (tysiace)
If tysiace = 1 Then
optysiecy = " tysiąc"
ElseIf tysiace > 10 And tysiace < 20 Then
optysiecy = " tysięcy"
ElseIf Right(tysiace, 1) = 2 Or Right(tysiace, 1) = 3 Or
Right(tysiace, 1) = 4 Then
optysiecy = " tysiące"
Else
optysiecy = " tysięcy"
End If
sltysiace = xxxslownie & optysiecy
Else
sltysiace = ""
End If
If miliony <> 0 Then
znajdz (miliony)
If miliony = 1 Then
opmilionow = " milion"
ElseIf miliony > 10 And miliony < 20 Then
opmilionow = " milionów"
ElseIf Right(miliony, 1) = 2 Or Right(miliony, 1) = 3 Or
Right(miliony, 1) = 4 Then
opmilionow = " miliony"
Else
opmilionow = " milionów"
End If
slmiliony = xxxslownie & opmilionow
Else
slmiliony = ""
End If
If miliardy <> 0 Then
znajdz (miliardy)
If miliardy = 1 Then
opmiliardow = " miliard"
ElseIf miliardy > 10 And miliardy < 20 Then
opmiliardow = " miliardów"
ElseIf Right(miliardy, 1) = 2 Or Right(miliardy, 1) = 3 Or
Right(miliardy, 1) = 4 Then
opmiliardow = " miliardy"
Else
opmiliardow = " miliardów"
End If
slmiliardy = xxxslownie & opmiliardow
Else
slmiliardy = ""
End If
If biliony <> 0 Then
znajdz (biliony)
If biliony = 1 Then
opbilionow = " bilion"
ElseIf biliony > 10 And biliony < 20 Then
opbilionow = " bilionów"
ElseIf Right(biliony, 1) = 2 Or Right(biliony, 1) = 3 Or
Right(biliony, 1) = 4 Then
opbilionow = " biliony"
Else
opbilionow = " bilionów"
End If
slbiliony = xxxslownie & opbilionow
Else
slbiliony = ""
End If
Slownie = Mid(slbiliony & slmiliardy & slmiliony & sltysiace &
sljedynki & waluta & grosze, 2)

End If

End Function
Private Function znajdz(xxx As Single)
Static liczby(9, 3) As String
liczby(0, 0) = 0
liczby(0, 1) = ""
liczby(0, 2) = ""
liczby(0, 3) = ""
liczby(1, 0) = 1
liczby(1, 1) = "jeden"
liczby(1, 2) = "dziesięć"
liczby(1, 3) = "sto"
liczby(2, 0) = 2
liczby(2, 1) = "dwa"
liczby(2, 2) = "dwadzieścia"
liczby(2, 3) = "dwieście"
liczby(3, 0) = 3
liczby(3, 1) = "trzy"
liczby(3, 2) = "trzydzieści"
liczby(3, 3) = "trzysta"
liczby(4, 0) = 4
liczby(4, 1) = "cztery"
liczby(4, 2) = "czterdzieści"
liczby(4, 3) = "czterysta"
liczby(5, 0) = 5
liczby(5, 1) = "pięć"
liczby(5, 2) = "pięćdziesiąt"
liczby(5, 3) = "pięćset"
liczby(6, 0) = 6
liczby(6, 1) = "sześć"
liczby(6, 2) = "sześćdziesiąt"
liczby(6, 3) = "sześćset"
liczby(7, 0) = 7
liczby(7, 1) = "siedem"
liczby(7, 2) = "siedemdziesiąt"
liczby(7, 3) = "siedemset"
liczby(8, 0) = 8
liczby(8, 1) = "osiem"
liczby(8, 2) = "osiemdziesiąt"
liczby(8, 3) = "osiemset"
liczby(9, 0) = 9
liczby(9, 1) = "dziewięć"
liczby(9, 2) = "dziewięćdziesiąt"
liczby(9, 3) = "dziewięćset"

Static jedenastki(8, 1) As String
jedenastki(0, 0) = 11
jedenastki(0, 1) = "jedenaście"
jedenastki(1, 0) = 12
jedenastki(1, 1) = "dwanaście"
jedenastki(2, 0) = 13
jedenastki(2, 1) = "trzynaście"
jedenastki(3, 0) = 14
jedenastki(3, 1) = "czternaście"
jedenastki(4, 0) = 15
jedenastki(4, 1) = "piętnaście"
jedenastki(5, 0) = 16
jedenastki(5, 1) = "szesnaście"
jedenastki(6, 0) = 17
jedenastki(6, 1) = "siedemnaście"
jedenastki(7, 0) = 18
jedenastki(7, 1) = "osiemnaście"
jedenastki(8, 0) = 19
jedenastki(8, 1) = "dziewiętnaście"


jeden = Right(xxx, 1)
dziesiecsamo = (Right(xxx, 2) - jeden) / 10
dziesiec = Right(xxx, 2)
sto = (xxx - dziesiec) / 100

If sto <> 0 Then
For i = 0 To 9
If liczby(i, 0) = sto Then stoslownie = " " & liczby(i, 3)
Next i
Else
stoslownie = ""
End If

If dziesiec < 20 And dziesiec > 10 Then
For i = 0 To 8
If jedenastki(i, 0) = dziesiec Then dziesiecslownie = " " &
jedenastki(i, 1)
Next i
xxxslownie = stoslownie & dziesiecslownie
Else
If dziesiecsamo <> 0 Then
For i = 0 To 9
If liczby(i, 0) = dziesiecsamo Then dziesiecslownie = " "
& liczby(i, 2)
Next i
Else
dziesiecslownie = ""
End If
If jeden <> 0 Then
For i = 0 To 9
If liczby(i, 0) = jeden Then jedenslownie = " " &
liczby(i, 1)
Next i
Else
jedenslownie = ""
End If

xxxslownie = stoslownie & dziesiecslownie & jedenslownie

End If

End Function