slownie.txt

(4 KB) Pobierz
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
Zgłoś jeśli naruszono regulamin