VBATools

Liczba słownie

by on Oct.11, 2011, under Excel, Porady

Wyjątkowo na tym forum umieszczam dwie funkcje, które nie są mojego autorstwa. Jednakże na potrzeby kolego w WSS umieszczam je dla waszego wykorzystania:

Pierwsza funkcja wartość 6732.98 zamienia na: “sześć tysięcy siedemset trzydzieści dwa złote  dziewięćdziesiąt osiem groszy”

Function Slownie(x)
Static setki(10) As String
Static dzies(10) As String
Static jedn(20) As String
setki(0) = ""
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"
dzies(0) = ""
dzies(1) = "dziesięć"
dzies(2) = "dwadzieścia"
dzies(3) = "trzydzieści"
dzies(4) = "czterdzieści"
dzies(5) = "pięćdziesiąt"
dzies(6) = "sześćdziesiąt"
dzies(7) = "siedemdziesiąt"
dzies(8) = "osiemdziesiąt"
dzies(9) = "dziewięćdziesiąt"
jedn(0) = ""
jedn(1) = "jeden"
jedn(2) = "dwa"
jedn(3) = "trzy"
jedn(4) = "cztery"
jedn(5) = "pięć"
jedn(6) = "sześć"
jedn(7) = "siedem"
jedn(8) = "osiem"
jedn(9) = "dziewięć"
jedn(10) = "dziesięć"
jedn(11) = "jedenaście"
jedn(12) = "dwanaście"
jedn(13) = "trzynaście"
jedn(14) = "czternaście"
jedn(15) = "piętnaście"
jedn(16) = "szesnaście"
jedn(17) = "siedemnaście"
jedn(18) = "osiemnaście"
jedn(19) = "dziewiętnaście"

 If x >= 1000000000000# Then
 Beep
 Slownie = "Wprowadź kwotę ręcznie!"
 MsgBox "funkcja działa od 0 do 1.000.000.000.000"
 Exit Function
 End If

 liczba = Int(x)
 l = (x - liczba) * 100
 liczbagr = Int(l)
 If (l - liczbagr) * 10 >= 5 Then liczbagr = liczbagr + 1
 liczbamld = Int(liczba / 1000000000)
 liczbamil = Int((liczba - liczbamld * 1000000000) / 1000000)
 liczbatys = Int((liczba - liczbamld * 1000000000 - liczbamil * 1000000) / 1000)
 liczbaset = Int(liczba - liczbamld * 1000000000 - liczbamil * 1000000 - liczbatys * 1000)

'************* liczenie miliardów
 liczba = liczbamld
 If liczba = 0 Then GoTo mil

 l = Int(liczba / 100)
 slowniezl$ = slowniezl$ + setki(l)

 liczba = liczba - (l * 100)
 If liczba < 20 Then slowniezl$ = slowniezl$ + " " + jedn(liczba): GoTo pisz_mld
 l = Int(liczba / 10)
 slowniezl$ = slowniezl$ + " " + dzies(l)

 liczba = liczba - (l * 10)
 slowniezl$ = slowniezl$ + " " + jedn(liczba)

pisz_mld:
 If liczbamld = 1 Then slowniezl$ = slowniezl$ + " miliard ": GoTo mil
 PO = Str$(liczba)
 py = Right(PO, 1)

 If PO >= 5 And PO < 20 Then slowniezl$ = slowniezl$ + " miliardów ": GoTo mil
 If py > 1 And py < 5 Then slowniezl$ = slowniezl$ + " miliardy ": GoTo mil
 If liczbamld >= 5 Then slowniezl$ = slowniezl$ + " miliardów "

mil:
'************* liczenie milionów

 liczba = liczbamil
 If liczba = 0 Then GoTo tys

 l = Int(liczba / 100)
 slowniezl$ = slowniezl$ + setki(l)

 liczba = liczba - (l * 100)
 If liczba < 20 Then slowniezl$ = slowniezl$ + " " + jedn(liczba): GoTo pisz_mil
 l = Int(liczba / 10)
 slowniezl$ = slowniezl$ + " " + dzies(l)

 liczba = liczba - (l * 10)
 slowniezl$ = slowniezl$ + " " + jedn(liczba)

pisz_mil:
 If liczbamil = 1 Then slowniezl$ = slowniezl$ + " milion ": GoTo tys
 PO = Str$(liczba)
 py = Right(PO, 1)

 If PO >= 5 And PO < 20 Then slowniezl$ = slowniezl$ + " milionów ": GoTo tys
 If py > 1 And py < 5 Then slowniezl$ = slowniezl$ + " miliony ": GoTo tys
 If liczbamil >= 5 Then slowniezl$ = slowniezl$ + " milionów "

tys:
'************* liczenie tysięcy

 liczba = liczbatys
 If liczba = 0 Then GoTo zl

 l = Int(liczba / 100)
 slowniezl$ = slowniezl$ + setki(l)

 liczba = liczba - (l * 100)
 If liczba < 20 Then slowniezl$ = slowniezl$ + " " + jedn(liczba): GoTo pisz_tys
 l = Int(liczba / 10)
 slowniezl$ = slowniezl$ + " " + dzies(l)

 liczba = liczba - (l * 10)
 slowniezl$ = slowniezl$ + " " + jedn(liczba)

pisz_tys:
 If liczbatys = 1 Then slowniezl$ = slowniezl$ + " tysiąc ": GoTo zl
 PO = Str$(liczba)
 py = Right(PO, 1)

 If PO >= 5 And PO < 20 Then slowniezl$ = slowniezl$ + " tysięcy ": GoTo zl
 If py > 1 And py < 5 Then slowniezl$ = slowniezl$ + " tysiące ": GoTo zl
 If liczbatys >= 5 Then slowniezl$ = slowniezl$ + " tysiecy "

zl:
'************** liczenie złotych
 liczba = liczbaset
 If Int(x) = 0 Then slowniezl$ = slowniezl$ + " zero złotych": GoTo gr
 If liczba = 0 Then slowniezl$ = slowniezl$ + " złotych": GoTo gr

 l = Int(liczba / 100)
 slowniezl$ = slowniezl$ + setki(l)

 liczba = liczba - (l * 100)
 If liczba < 20 Then slowniezl$ = slowniezl$ + " " + jedn(liczba): GoTo pisz_zl
 l = Int(liczba / 10)
 slowniezl$ = slowniezl$ + " " + dzies(l)

 liczbaa = liczba - (l * 10)
 slowniezl$ = slowniezl$ + " " + jedn(liczbaa)

pisz_zl:
 PO = Str$(liczba)
 py = Right(PO, 1)

 If PO >= 5 And PO < 20 Then slowniezl$ = slowniezl$ + " złotych": GoTo gr
 If py >= 2 And py < 5 Then slowniezl$ = slowniezl$ + " złote": GoTo gr
 If PO = 1 Then slowniezl$ = slowniezl$ + " złoty"
 If liczbaset >= 5 Then slowniezl$ = slowniezl$ + " złotych"

gr:
'************ liczenie groszy

 liczba = liczbagr
 If liczba = 0 Then slowniegr$ = "zero groszy": GoTo Wynik
 If liczba < 20 Then slowniegr$ = jedn(liczba): GoTo pisz_gr

 l = Int(liczba / 10)
 slowniegr$ = slowniegr$ + " " + dzies(l)

 liczba = liczba - (l * 10)
 slowniegr$ = slowniegr$ + " " + jedn(liczba)

pisz_gr:
 PO = Str$(liczbagr)
 py = Right(PO, 1)

 If PO >= 5 And PO < 20 Then slowniegr$ = slowniegr$ + " groszy": GoTo Wynik
 If py >= 2 And py < 5 Then slowniegr$ = slowniegr$ + " grosze": GoTo Wynik
 If PO = 1 Then slowniegr$ = slowniegr$ + " grosz": GoTo Wynik
 If PO >= 5 Then slowniegr$ = slowniegr$ + " groszy"

Wynik:
 Slownie = slowniezl$ + " " + slowniegr$
End Function

Druga funkcja wartość 6732.98 zamienia na: “Sześć Tysięcy Siedemset Trzydzieści Dwa Złote  i 98/100 gr.”

Public Function Słownie_Liczba(x)
Dim b&, c&, d&, e&, F&, G, zwracana$

If x < 0 Then
 zwracana = "Minus "
 x = -x
End If

If x = 0 Then zwracana = "Zero "

b = Int(x / 10000)
Select Case b
 Case 1:        zwracana = "Dziesięć "
 Case 2:        zwracana = "Dwadzieścia "
 Case 3:        zwracana = "Trzydzieści "
 Case 4:        zwracana = "Czterdzieści "
 Case 5:        zwracana = "Pięćdziesiąt "
 Case 6:        zwracana = "Sześćdziesiąt "
 Case 7:        zwracana = "Siedemdziesiąt "
 Case 8:        zwracana = "Osiemdziesiąt "
 Case 9:        zwracana = "Dziewięćdziesiąt "
End Select

c = Int((x - b * 10000) / 1000)
Select Case c
 Case 0
 If b <> 0 Then
 zwracana = zwracana + "Tysięcy "
 Else
 GoTo next_d
 End If
 Case 1
 If b = 1 Then
 zwracana = "Jedenaście Tysięcy "
 Else
 If b = 0 Then
 zwracana = "Tysiąc "
 Else
 zwracana = zwracana + "Jeden Tysięcy "
 End If
 End If
 Case 2
 If b = 1 Then
 zwracana = "Dwanaśnie Tysięcy "
 Else
 zwracana = zwracana + "Dwa Tysiące "
 End If
 Case 3
 If b = 1 Then
 zwracana = "Trzynaście Tysięcy "
 Else
 zwracana = zwracana + "Trzy Tysiące "
 End If
 Case 4
 If b = 1 Then
 zwracana = "Czternaście Tysięcy "
 Else
 zwracana = zwracana + "Cztery Tysiące "
 End If
 Case 5
 If b = 1 Then
 zwracana = "Piętnaście Tysięcy "
 Else
 zwracana = zwracana + "Pięć Tysięcy "
 End If
 Case 6
 If b = 1 Then
 zwracana = "Szesnaście Tysięcy "
 Else
 zwracana = zwracana + "Sześć Tysięcy "
 End If
 Case 7
 If b = 1 Then
 zwracana = "Siedemnaście Tysięcy "
 Else
 zwracana = zwracana + "Siedem Tysięcy "
 End If
 Case 8
 If b = 1 Then
 zwracana = "Osiemnaście Tysięcy "
 Else
 zwracana = zwracana + "Osiem Tysięcy "
 End If
 Case 9
 If b = 1 Then
 zwracana = "Dziewiętnaście Tysięcy "
 Else
 zwracana = zwracana + "Dziewięć Tysięcy "
 End If
End Select

next_d:
d = Int((x - b * 10000 - c * 1000) / 100)
Select Case d
 Case 1:        zwracana = zwracana + "Sto "
 Case 2:        zwracana = zwracana + "Dwieście "
 Case 3:        zwracana = zwracana + "Trzysta "
 Case 4:        zwracana = zwracana + "Czterysta "
 Case 5:        zwracana = zwracana + "Pięćset "
 Case 6:        zwracana = zwracana + "Sześćset "
 Case 7:        zwracana = zwracana + "Siedemset "
 Case 8:        zwracana = zwracana + "Osiemset "
 Case 9:        zwracana = zwracana + "Dziewięćset "
End Select

e = Int((x - b * 10000 - c * 1000 - d * 100) / 10)
Select Case e
 Case 2:        zwracana = zwracana + "Dwadzieścia "
 Case 3:        zwracana = zwracana + "Trzydzieści "
 Case 4:        zwracana = zwracana + "Czterdzieści "
 Case 5:        zwracana = zwracana + "Pięćdziesiąt "
 Case 6:        zwracana = zwracana + "Sześćdziesiąt "
 Case 7:        zwracana = zwracana + "Siedemdziesiąt "
 Case 8:        zwracana = zwracana + "Osiemdziesiąt "
 Case 9:        zwracana = zwracana + "Dziewięćdziesiąt "
End Select

F = Int(x - b * 10000 - c * 1000 - d * 100 - e * 10)
Select Case F
 Case 0
 If e = 1 Then
 zwracana = zwracana + "Dziesięć " + "Złotych "
 Else
 zwracana = zwracana + "Złotych "
 End If
 Case 1
 If e = 1 Then
 zwracana = zwracana + "Jedenaście Złotych "
 Else
 If e = 0 And d = 0 And c = 0 And b = 0 Then
 zwracana = zwracana + "Jeden Złoty "
 Else
 zwracana = zwracana + "Jeden Złotych "
 End If
 End If
 Case 2
 If e = 1 Then
 zwracana = zwracana + "Dwanaśnie Złotych "
 Else
 zwracana = zwracana + "Dwa Złote "
 End If
 Case 3
 If e = 1 Then
 zwracana = zwracana + "Trzynaście Złotych "
 Else
 zwracana = zwracana + "Trzy Złote "
 End If
 Case 4
 If e = 1 Then
 zwracana = zwracana + "Czternaście Złotych "
 Else
 zwracana = zwracana + "Cztery Złote "
 End If
 Case 5
 If e = 1 Then
 zwracana = zwracana + "Piętnaście Złotych "
 Else
 zwracana = zwracana + "Pięć Złotych "
 End If
 Case 6
 If e = 1 Then
 zwracana = zwracana + "Szesnaście Złotych "
 Else
 zwracana = zwracana + "Sześć Złotych "
 End If
 Case 7
 If e = 1 Then
 zwracana = zwracana + "Siedemnaście Złotych "
 Else
 zwracana = zwracana + "Siedem Złotych "
 End If
 Case 8
 If e = 1 Then
 zwracana = zwracana + "Osiemnaście Złotych "
 Else
 zwracana = zwracana + "Osiem Złotych "
 End If
 Case 9
 If e = 1 Then
 zwracana = zwracana + "Dziewiętnaście Złotych "
 Else
 zwracana = zwracana + "Dziewięć Złotych "
 End If
End Select

G = (x - b * 10000 - c * 1000 - d * 100 - e * 10 - F) * 100
 zwracana = zwracana + " i " + Format(G, "0") + "/100 gr. "
 'zwracana = zwracana + " i "

Słownie_Liczba = zwracana
End Function

Druga funkcja, ze względu na swoją skrótową formę sprawdza się idealnie w przy zastosowaniu w dokumentach finansowych.

Funkcje wystawiam na potrzeby forumowicza wss.

(c) Shon Oskar – www.VBATools.pl

:, ,

3 Comments for this entry

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała