kopia z http://www.vb4all.pl/content/view/131/25/
bo znowu będę szukal
Function slownie(liczba$)
Dim waluta$
dim grosze$
dim zlote$
'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
