VBA Tools

Wyjątkowo na tym forum umieszczam dwie funkcje, które nie są mojego autorstwa. Jednakże na potrzeby kolegi z 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.

Dla wielkich liczb można zastosować też taką odmianę:

Option Compare Binary
Option Explicit

Private JEDNOSTKI(0 To 9) As String
Private NASCIE(0 To 9) As String
Private DZIESIATKI(0 To 9) As String
Private SETKI(0 To 9) As String

Private ZLOTY(-1 To 4) As String
Private GROSZY(-1 To 4) As String
Private TYSIAC(-1 To 4) As String
Private MILION(-1 To 4) As String
Private MILIARD(-1 To 4) As String
Private BILION(-1 To 4) As String

Private slownie_buff&
Private koncowka As Integer

Sub test()
Debug.Print Slownie(999000000)
End Sub

Private Function LMod(ByVal n1, ByVal n2) As Currency
On Error Resume Next
 LMod = 0
 n1 = n1
 n2 = n2
 If n2 = 0 Then Exit Function

 While n1 >= n2
 n1 = n1 - n2
 If Err <> 0 Then
 Err = 0
 Exit Function
 End If
 Wend

 LMod = n1
End Function

Private Function rozbij_tysiac(tysiac_val As Currency)
On Error Resume Next

 Dim s$, i As Currency
 Dim T As Currency: T = tysiac_val

 s = ""
 koncowka = 3
 i = Int(T / 100)
 T = LMod(T, 100)
 s = SETKI(i)
 i = Int(T / 10)
 T = LMod(T, 10)

 If i <> 1 Then
 s = s & DZIESIATKI(i)
 s = s & JEDNOSTKI(T)
 Select Case T
 Case 1: If tysiac_val = 1 Then koncowka = 1 ' inna końcówka dla 1
 Case 2, 3, 4: koncowka = 2
 End Select
 Else
 s = s & NASCIE(T)
 End If

 rozbij_tysiac = s
End Function

Public Function Slownie(ByVal L As Double, Optional ByVal skroty As Boolean = False, Optional ByVal Polish As Boolean = True) As String
 Dim s$, i As Currency
 Call slownie_init_PL
 s = ""
 koncowka = 3

 If L < 0 Then
 s = s & "minus ": L = -L
 End If

 If L = 0 Then
 s = "zero "
 End If

 i = Int(L / 1000000000000@)
 If i <> 0 Then
 s = s & rozbij_tysiac(i)
 If skroty = True Then
 s = s & BILION(-1)
 Else
 s = s & BILION(koncowka)
 koncowka = 3
 End If
 End If
 L = LMod(L, 1000000000000@)

 i = Int(L / 1000000000@)
 If i <> 0 Then
 s = s & rozbij_tysiac(i)
 If skroty = True Then
 s = s & MILIARD(-1)
 Else
 s = s & MILIARD(koncowka)
 koncowka = 3
 End If
 End If
 L = LMod(L, 1000000000@)

 i = Int(L / 1000000@)
 If i <> 0 Then
 s = s & rozbij_tysiac(i)
 If skroty = True Then
 s = s & MILION(-1)
 Else
 s = s & MILION(koncowka)
 koncowka = 3
 End If
 End If
 L = LMod(L, 1000000@)

 i = Int(L / 1000@)
 If i <> 0 Then
 s = s & rozbij_tysiac(i)
 If skroty = True Then
 s = s & TYSIAC(-1)
 Else
 s = s & TYSIAC(koncowka)
 koncowka = 3
 End If
 End If
 L = LMod(L, 1000@)

 i = Int(L / 1@)
 If i <> 0 Then
 s = s & rozbij_tysiac(i)
 End If

 Slownie = s
End Function

Private Sub slownie_init_PL()
 JEDNOSTKI(0) = ""
 JEDNOSTKI(1) = "jeden "
 JEDNOSTKI(2) = "dwa "
 JEDNOSTKI(3) = "trzy "
 JEDNOSTKI(4) = "cztery "
 JEDNOSTKI(5) = "pięć "
 JEDNOSTKI(6) = "sześć "
 JEDNOSTKI(7) = "siedem "
 JEDNOSTKI(8) = "osiem "
 JEDNOSTKI(9) = "dziewięć "

 NASCIE(0) = "dziesięć "
 NASCIE(1) = "jedenaście "
 NASCIE(2) = "dwanaście "
 NASCIE(3) = "trzynaście "
 NASCIE(4) = "czternaście "
 NASCIE(5) = "piętnaście "
 NASCIE(6) = "szesnaście "
 NASCIE(7) = "siedemnaście "
 NASCIE(8) = "osiemnaście "
 NASCIE(9) = "dziewiętnaście "

 DZIESIATKI(0) = ""
 DZIESIATKI(1) = ""
 DZIESIATKI(2) = "dwadzieścia "
 DZIESIATKI(3) = "trzydzieści "
 DZIESIATKI(4) = "czterdzieści "
 DZIESIATKI(5) = "pięćdziesiąt "
 DZIESIATKI(6) = "sześćdziesiąt "
 DZIESIATKI(7) = "siedemdziesiąt "
 DZIESIATKI(8) = "osiemdziesiąt "
 DZIESIATKI(9) = "dziewięćdziesiąt "

 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 "

 ZLOTY(-1) = "zł. "
 ZLOTY(0) = "złoty"
 ZLOTY(1) = "złoty i "
 ZLOTY(2) = "złote i "
 ZLOTY(3) = "złotych i "

 GROSZY(-1) = "gr. "
 GROSZY(0) = "grosz"
 GROSZY(1) = "grosz "
 GROSZY(2) = "grosze "
 GROSZY(3) = "groszy "

 TYSIAC(-1) = "tys. "
 TYSIAC(0) = "tysiąc"
 TYSIAC(1) = "tysiąc "
 TYSIAC(2) = "tysiące "
 TYSIAC(3) = "tysięcy "

 MILION(-1) = "mln. "
 MILION(0) = "milion"
 MILION(1) = "milion "
 MILION(2) = "miliony "
 MILION(3) = "milionów "

 MILIARD(-1) = "mld. "
 MILIARD(0) = "miliard"
 MILIARD(1) = "miliard "
 MILIARD(2) = "miliardy "
 MILIARD(3) = "miliardów "

 BILION(0) = "bln. "
 BILION(0) = "bilion"
 BILION(1) = "bilion "
 BILION(2) = "biliony "
 BILION(3) = "bilionów "
End Sub

Funkcje wystawiam na potrzeby forumowicza – WSS.pl.