Szybkie szukanie
S³owo kluczowe:
niedziela, 05 luty 2012
Start arrow Tips & Tricks arrow Zamiana liczb na s³owa
Zamiana liczb na s³owa Drukuj E-mail
Napisa³ Administrator   
wtorek, 24 styczeñ 2006
Function slownie(liczba$)

'mielimy liczbê:
'je¶li nie ma koñcówki dodajemy ",00"
If InStr(1, liczba$, ",") = 0 Then liczba$ = liczba$ + ",00"
'teraz rozbicie na zlote i grosze:
zlotowki$ = Left$(liczba$, InStr(1, liczba$, ",") - 1)
grosze$ = Right$(liczba$, Len(liczba$) - InStr(1, liczba$, ","))
If Len(grosze$) = 1 Then grosze$ = grosze$ + "0"

Dim rzedy(7, 10)
rzedy(1, 0) = ""
rzedy(1, 1) = "jeden "
rzedy(1, 2) = "dwa "
rzedy(1, 3) = "trzy "
rzedy(1, 4) = "cztery "
rzedy(1, 5) = "piêæ "
rzedy(1, 6) = "sze¶æ "
rzedy(1, 7) = "siedem "
rzedy(1, 8) = "osiem "
rzedy(1, 9) = "dziewiêæ "
rzedy(0, 0) = "dziesiêæ "
rzedy(0, 1) = "jedena¶cie "
rzedy(0, 2) = "dwana¶cie "
rzedy(0, 3) = "trzyna¶cie "
rzedy(0, 4) = "czterna¶cie "
rzedy(0, 5) = "piêtna¶cie "
rzedy(0, 6) = "szesna¶cie "
rzedy(0, 7) = "siedemna¶cie "
rzedy(0, 8) = "osiemna¶cie "
rzedy(0, 9) = "dziewiêtna¶cie "
rzedy(2, 0) = ""
rzedy(2, 1) = "dziesiêæ "
rzedy(2, 2) = "dwadzie¶cia "
rzedy(2, 3) = "trzydzie¶ci "
rzedy(2, 4) = "czterdzie¶ci "
rzedy(2, 5) = "piêædziesi±t "
rzedy(2, 6) = "sze¶ædziesi±t "
rzedy(2, 7) = "siedemdziesi±t "
rzedy(2, 8) = "osiemdziesi±t "
rzedy(2, 9) = "dziewiêædziesi±t "
rzedy(3, 0) = ""
rzedy(3, 1) = "sto "
rzedy(3, 2) = "dwie¶cie "
rzedy(3, 3) = "trzysta "
rzedy(3, 4) = "czterysta "
rzedy(3, 5) = "piêæset "
rzedy(3, 6) = "sze¶æset "
rzedy(3, 7) = "siedemset "
rzedy(3, 8) = "osiemset "
rzedy(3, 9) = "dziewiêæset "
If Len(zlotowki$) <= 4 Then
rzedy(4, 1) = "tysi±c "
Else
rzedy(4, 1) = "tysiêcy "
End If
rzedy(4, 2) = "tysi±ce "
rzedy(4, 3) = "tysi±ce "
rzedy(4, 4) = "tysi±ce "
rzedy(4, 5) = "tysiêcy "
rzedy(4, 6) = "tysiêcy "
rzedy(4, 7) = "tysiêcy "
rzedy(4, 8) = "tysiêcy "
rzedy(4, 9) = "tysiêcy "
If Len(zlotowki$) <= 7 Then
rzedy(7, 1) = "milion "
Else
rzedy(7, 1) = "milionów "
End If
rzedy(7, 2) = "miliony "
rzedy(7, 3) = "miliony "
rzedy(7, 4) = "miliony "
rzedy(7, 5) = "milionów "
rzedy(7, 6) = "milionów "
rzedy(7, 7) = "milionów "
rzedy(7, 8) = "milionów "
rzedy(7, 9) = "milionów "

'teraz mozna zamieniac zlotowki:
a$ = zlotowki$: petla$ = "zlote"
If Val(zlotowki$) = 0 Then
rzedy(1, 0) = "zero "
Else
rzedy(1, 0) = ""
End If

koncowka = Right$(zlotowki$, 1)
If (koncowka = 2 Or koncowka = 3 Or koncowka = 4) And Mid$(zlotowki$, Len(zlotowki$) - 1, 1) <>
1 Then
waluta$ = "z³ote"
Else
waluta$ = "z³otych"
End If

maszynka:
c$ = ""
b$ = ""
For n = Len(a$) To 1 Step -1
b$ = b$ + Mid(a$, n, 1)
Next n

For y = 1 To Len(b$)
If y Mod 3 <> 0 Then
n = y Mod 3
Else
n = 3
End If
x = Val(Mid$(b$, y, 1))
If y = 4 Then c$ = rzedy(4, x) + c$
If y = 7 Then c$ = rzedy(7, x) + c$
If n = 1 And Val(Mid$(b$, y + 1, 1)) = 1 Then
c$ = rzedy(n - 1, x) + c$:
y = y + 1
Else
c$ = rzedy(n, x) + c$
End If
Next y
'sprawdzmy, czy juz koniec:
If petla = "grosze" Then GoTo dalej
zlote$ = c$ + waluta
'teraz czas na grosze:
a$ = grosze$: petla$ = "grosze"
If Val(grosze$) = 0 Then
rzedy(1, 0) = "zero "
Else
rzedy(1, 0) = ""
End If
koncowka = Right$(grosze$, 1)
If (koncowka = 2 Or koncowka = 3 Or koncowka = 4) And Left$(grosze$, 1) <> 1 Then
waluta$ = "grosze"
Else
waluta$ = "groszy"
End If
GoTo maszynka
dalej:
grosze$ = c$ + waluta

slownie = zlote$ + " i " + grosze$

End Function

Komentarze
zapomnia? ten autor...
Dodane przez djmati11 w dniu - 2006-10-14 15:54:54
...Dopisa? na pocz±tku: 
Dim waluta$ 
dim grosze$ 
dim zlote$

Aby dodaæ komentarz zaloguj siê. Je¶li nie masz konta, za³ó¿ je sobie.
Tylko zarejestrowani u¿ytkownicy mog± pisaæ komentarze.

Powered by AkoComment 2.0!

< Poprzedni   Nastêpny >

Menu g³ówne
Start
Teoria
VB.NET
Api
Tips & Tricks
Warsztat
VBMagazine
Pliki
Forum
Literatura
Ankiety
Linki
Szukaj
Wy¶lij program
Napisz do nas
Redakcja
Logowanie
Login

Has³o

Zapamiêtaj mnie
Nie pamiêtasz has³a?
Nie masz konta? Za³ó¿ je sobie
Go¶cimy
Aktualnie jest 46 go¶ci online
Statystyka
U¿ytkownicy: 11344
Newsy: 237
Odno¶niki: 48
Odwiedzaj±cych: 4318525
Mambo is Free Software released under the GNU/GPL License.