Function Słownie(x As Variant) As String 'dla liczb od -999 999 999 999.99 do 999 999 999 999.99
'Sprawdzamy czy podana kwota jest mniejsza od zera jeśli jest to dopisujemy do kwoty słownie słowo minus
If x < 0 Then w = w & "minus "

'Konwertujemy liczbę na zapis, który będzie pokazywał zawsze miliardy miliony, tysiące i jednostki
'nawet jeśli będą to same zera
x = Format(Abs(x), "000 000 000 000.00")
'części odpowiedzialne za miliardy, miliony itd. przypisujemy do oddzielnych zmiennych 3 cyfrowych
'wiodące zera również są w nich brane pod uwagę, a do groszy musimy dodać jedna zero na początku
'żeby później działało odpowiednio z funckją trzy
mld = Left(x, 3): m = Mid(x, 5, 3): t = Mid(x, 9, 3): j = Mid(x, 13, 3): g = Right(x, 2)

'Sprawdzamy miliardy i w zależności od ich ilości nadajemy inne końcówki
'analogicznie robimy z milionami, tysiącami, jednościami i groszami
Select Case mld
    Case 0
    Case 1
        w = "jeden miliard "
    Case Else
        'za pomocą funkcji trzy sprawdzamy jaka jest liczba miliardów, a późniejszych częściach milionów itd.
        w = w & trzy(mld)
        'dodajemy odpowiedni "końcówek" na podstawie połączeniu odpowiednich warunków
        If Mid(mld, 2, 1) <> 1 And (Right(mld, 1) = 2 Or Right(mld, 1) = 3 Or Right(mld, 1) = 4) Then w = w & "miliardy " Else w = w & "miliardów "
End Select

'Sprawdzanie milionów analogicznie jak miliardów
Select Case m
    Case 0
    Case 1
        w = "jeden milion "
    Case Else
    w = w & trzy(m)
    If Mid(m, 2, 1) <> 1 And (Right(m, 1) = 2 Or Right(m, 1) = 3 Or Right(m, 1) = 4) Then w = w & "miliony " Else w = w & "milionów "
End Select

'Sprawdzanie tysięcy analogicznie jak miliardów
Select Case t
    Case 0
    Case 1
        w = w & "jeden tysiąc "
    Case Else
        w = w & trzy(t)
        If Mid(t, 2, 1) <> 1 And (Right(t, 1) = 2 Or Right(t, 1) = 3 Or Right(t, 1) = 4) Then w = w & "tysiące " Else w = w & "tysięcy "
End Select

'Sprawdzanie jedności analogicznie jak miliardów
Select Case j
    Case 0
        If mld = 0 And m = 0 And t = 0 Then w = w & "zero złotych " Else w = w & "zł "
    Case 1
        If mld = 0 And m = 0 And t = 0 Then w = w & "jeden złoty " Else w = w & "zł "
    Case Else
        w = w & trzy(j)
        If Mid(j, 2, 1) <> 1 And (Right(j, 1) = 2 Or Right(j, 1) = 3 Or Right(j, 1) = 4) Then w = w & "zł " Else w = w & "zł "
End Select

'sprawdzanie groszy analogicznie jak miliardów
Select Case g
    Case 0
        w = w & "0/100"
    Case Else
        w = w & g
        w = w & "/100"
End Select

Słownie = w
End Function

Function trzy(x As Variant) As String
'dzielimy trzy cyfry na część odpowiedzialną za setki, dziesiątki i jedności
x3 = Val(Left(x, 1)): x2 = Val(Mid(x, 2, 1)): x1 = Val(Right(x, 1))
'Spradzamy jaka to setka
If x3 = 9 Then w = w & "dziewięćset "
If x3 = 8 Then w = w & "osiemset "
If x3 = 7 Then w = w & "siedemset "
If x3 = 6 Then w = w & "sześćset "
If x3 = 5 Then w = w & "pięćset "
If x3 = 4 Then w = w & "czterysta "
If x3 = 3 Then w = w & "trzysta "
If x3 = 2 Then w = w & "dwieście "
If x3 = 1 Then w = w & "sto "
'Sprawdzamy jaka to dziesiątka łącząc z ewentualną setką
If x2 = 9 Then w = w & "dziewięćdziesiąt "
If x2 = 8 Then w = w & "osiemdziesiąt "
If x2 = 7 Then w = w & "siedemdziesiąt "
If x2 = 6 Then w = w & "sześćdziesiąt "
If x2 = 5 Then w = w & "pięćdziesiąt "
If x2 = 4 Then w = w & "czterdzieści "
If x2 = 3 Then w = w & "trzydzieści "
If x2 = 2 Then w = w & "dwadzieścia "
'Sprawdzamy czy to nie jest nastka łącząc z ewentualną setką
If x2 = 1 Then
    If x1 = 9 Then w = w & "dziewiętnaście "
    If x1 = 8 Then w = w & "osiemnaście "
    If x1 = 7 Then w = w & "siedemnaście "
    If x1 = 6 Then w = w & "szesnaście "
    If x1 = 5 Then w = w & "piętnaście "
    If x1 = 4 Then w = w & "czternaście "
    If x1 = 3 Then w = w & "trzynaście "
    If x1 = 2 Then w = w & "dwanaście "
    If x1 = 1 Then w = w & "jedenaście "
    If x1 = 0 Then w = w & "dziesięć "
End If
'Sprawdzamy jaka to cyfra jedności i dołączamy do ewentualnej wcześniejszej części
If x2 <> 1 Then
    If x1 = 9 Then w = w & "dziewięć "
    If x1 = 8 Then w = w & "osiem "
    If x1 = 7 Then w = w & "siedem "
    If x1 = 6 Then w = w & "sześć "
    If x1 = 5 Then w = w & "pięć "
    If x1 = 4 Then w = w & "cztery "
    If x1 = 3 Then w = w & "trzy "
    If x1 = 2 Then w = w & "dwa "
    If x1 = 1 Then w = w & "jeden "
End If
trzy = w
End Function