Zamiana liczby na słowny odpowiednik
Dodane przez piotr dnia February 16 2007 20:48:58

---

Padło pytanie zasługujące na odpowiedź. wolfik123 napisał:
Czy ktoś ma może makro które wpisuje słownie daną kwotę?
Jest problem.... trzeba pomóc. Na jednym z forów dyskusyjnych dotyczących excela zostało zamieszczone poniżej cytowane makro. Jest ono bardzo ciekawe bo bez zmian działa w excel'u i calc'u. Takie rozwiązania zdecydowanie polecamy. Autor, żeby zabezpieczyć makro przed bezmyślnym kopiowaniem, pozostawił w kodzie pewien błąd. Pozwoliłem sobie przejrzeć to makro i usunąć 1 (słownie jeden) błąd. Mam nadzieję, że to już wszystkie pułapki autora ale głowy nie daję. Dlatego radzę przed przedstawieniem niniejszego kodu jako własnego SPRAWD¬ GO! WARTO!! A teraz do dzieła oto "mroczny przedmiot pożądania":



Public Function slownie(wejscie As Variant) As String

'Funkcja konwersji wartosci liczbowej (int/cur/double/float) na liczebnik (string)
'---------------------------------------------------------------------------
' ................... autor : Barman .. bke@o2.pl
'.................... poprawił : piotr snob.ovh.org
'....................................
'---------------------------------------------------------------------------

'........ UWAGA ....................
'Autor nie bierze odpowiedzialności, za ewentualne niewłasciwe działanie 'programu ;-)
'W FUNKCJI CELOWO ZOSTA£ ZASZYTY PEWIEN B£¡D, zatem bezmyślne kopiowanie i
'wpinanie funkcji do własnych komercyjnych aplikacji nie jest wskazane
'Piotr napisał:
'jeden błąd usunąłem jeżeli jest jeszcze inny to... sorry
'...................................

Dim tys_pusty As Boolean
Dim mln_pusty As Boolean
Dim ile_cyfr As Integer
Dim liczba As Variant
Dim i As Integer
Dim temp As String
Dim jednosci As Variant
Dim dziesiatki As Variant
Dim setki As Variant
Dim tys As Variant
Dim milion As Variant
Dim miliard As Variant
Dim bilion As Variant

'definicje tablic liczebników składowych
jednosci = Array("", "jeden ", " dwa ", " trzy ", " cztery ", " pięć ", "sześć ", " siedem ", " osiem ", " dziewięć ")
dziesiatki = Array("", " dziesięć ", " dwadzieścia ", " trzydzieści ", "czterdzieści ", " pięćdziesiąt ", " sześćdziesiąt ", " siedemdziesiąt ", "osiemdziesiąt ", " dziewięćdziesiąt ")
setki = Array("", " sto ", " dwieście ", " trzysta ", " czterysta ", "pięćset ", " sześćset ", " siedemset ", " osiemset ", " dziewięćset ")
tys = Array("", " tysiąc ", " tysiące ", " tysięcy ")
milion = Array("", " milion ", " miliony ", " milionów ")
miliard = Array("", " miliard ", " miliardy ", " miliardów ")
bilion = Array("", " bilion ", " biliony ", " bilionów ")

nascie = Array("", " jedenaście ", " dwanaście ", " trzynaście ", "czternaście ", " piętnaście ", " szesnaście ", " siedemnaście ", "osiemnaście ", " dziewiętnaście ")
tys_pusty = False
mln_pusty = False
flgnast = False
napis = Format(wejscie, "####0.00")
slownie=""
ile_cyfr = Len(napis) - 3


For i = 1 To ile_cyfr
Select Case (( (3 + ile_cyfr - i)) Mod 3)
Case 1
If ((ile_cyfr > 1) And (Val(Mid(napis, (i), 2)) < 20) And (Val(Mid(napis, (i), 2)) > 10)) Then
slownie = slownie & nascie(Val(Mid(napis, i + 1, 1)))
i = i + 1
flgnast = True
Else
slownie = slownie & dziesiatki(Val(Mid(napis, i, 1)))
End If

Case 0
slownie = slownie & jednosci(Val(Mid(napis, i, 1)))

Case Else
slownie = slownie & setki(Val(Mid(napis, i, 1)))
End Select


If ((ile_cyfr - i) = 12) Then
Select Case Val(Mid(napis, i, 1))
Case 1
If (ile_cyfr) > 13 Then
slownie = slownie & bilion(3)
Else
slownie = slownie & bilion(1)
End If
Case 2 To 4
slownie = slownie & bilion(2)
Case Else
slownie = slownie & bilion(3)
End Select
End If

If (ile_cyfr - i) = 9 Then

If flgnast = True Then
slownie = slownie & miliard(3)
flgnast = False
Else
Select Case Val(Mid(napis, i, 1))
Case 1
If (ile_cyfr) > 10 Then
slownie = slownie & miliard(3)
Else
slownie = slownie & miliard(1)
End If
Case 2 To 4
slownie = slownie & miliard(2)
Case Else
slownie = slownie & miliard(3)
End Select
End If
End If

If (ile_cyfr - i) = 6 Then
If (Val(Mid(napis, (i + 1), 3)) = 0) Then
tys_pusty = True
End If

If flgnast = True Then
slownie = slownie & milion(3)
flgnast = False
Else
Select Case Val(Mid(napis, i, 1))
Case 1
If (ile_cyfr) > 7 Then
slownie = slownie & milion(3)
Else
slownie = slownie & milion(1)
End If
Case 2 To 4
slownie = slownie & milion(2)
Case Else
slownie = slownie & milion(3)
End Select
End If
End If

If ((ile_cyfr - i) = 3 And tys_pusty = False) Then
If flgnast = True Then
slownie = slownie & tys(3)
flgnast = False
Else
Select Case Val(Mid(napis, i, 1))
Case 1
If (ile_cyfr) > 4 Then
slownie = slownie & tys(3)
Else
slownie = slownie & tys(1)
End If
Case 2 To 4
slownie = slownie & tys(2)
Case Else
slownie = slownie & tys(3)
End Select
End If
End If

Next

slownie = slownie & " zł "
slownie = slownie & Mid(napis, (Len(napis) - 1), 2) & "/100 gr"

End Function


POWODZENIA!