Attribute VB_Name = "Moduł1"
Option Explicit

Public Function LiczbaSlownie(WartoscLiczbowa)
Dim LiczbaStr As String
Dim DlugoscLiczby As Integer
Dim s As String
Dim Ulamek As Long


Ulamek = (WartoscLiczbowa - Fix(WartoscLiczbowa)) * 100
If Ulamek < 0 Then Ulamek = Ulamek + 100


WartoscLiczbowa = Fix(WartoscLiczbowa)

LiczbaStr = (WartoscLiczbowa)
DlugoscLiczby = CInt(Len(LiczbaStr))

Select Case DlugoscLiczby
Case 0
    LiczbaSlownie = ""
Case 1 To 3
    LiczbaSlownie = OpiszSetki(WartoscLiczbowa)
Case 4 To 6
    LiczbaSlownie = OpiszTysiac(WartoscLiczbowa)
Case 7 To 9
    LiczbaSlownie = OpiszMilion(WartoscLiczbowa)
Case 10 To 12
    LiczbaSlownie = OpiszMiliard(WartoscLiczbowa)
Case Else
    LiczbaSlownie = ""
End Select

LiczbaSlownie = LiczbaSlownie + " zł. "
If Ulamek > 0 Then LiczbaSlownie = LiczbaSlownie + ", " + OpiszSetki(Ulamek) + " gr."


'If ActiveCell.NumberFormat = "#,##0.00 $" Then LiczbaSlownie = LiczbaSlownie + " zł."
's = WartoscLiczbowa.Address()
'If Range(s) = "#,##0.00 $" Then
End Function

Private Function OpiszMiliard(liczba) As String
Dim o1E9(3)
o1E9(1) = " miliard": o1E9(2) = " miliardy": o1E9(3) = " miliardów"
Dim s As String
Dim liczba1
    
    liczba1 = liczba
    s = CStr(liczba1)
    s = Left(liczba1, Len(liczba1) - 9)
    liczba1 = CVar(s)
    OpiszMiliard = OpiszSlownie(liczba1)
    Select Case liczba1
    Case 1
            If CVar(s) = 1 Then OpiszMiliard = OpiszMiliard + " " + o1E9(1)
            If CVar(s) > 1 Then OpiszMiliard = OpiszMiliard + " " + o1E9(3)
    Case 2 To 4
            OpiszMiliard = OpiszMiliard + " " + o1E9(2)
    Case Else
            OpiszMiliard = OpiszMiliard + " " + o1E9(3)
    End Select
    OpiszMiliard = OpiszMiliard + OpiszMilion(liczba)
End Function

Private Function OpiszMilion(liczba) As String
Dim o1E6(3)
o1E6(1) = " milion":  o1E6(2) = " miliony":  o1E6(3) = " milionów"

Dim s As String
Dim liczba1
    
    liczba1 = liczba
    s = CStr(liczba1)
    If Len(s) > 9 Then s = Right(s, 9)
    s = Left(s, Len(s) - 6)
    liczba1 = CVar(s)
    OpiszMilion = OpiszSlownie(liczba1)
    If OpiszMilion <> "" Then
        Select Case liczba1
        Case 1
                If CVar(s) = 1 Then OpiszMilion = OpiszMilion + " " + o1E6(1)
                If CVar(s) > 1 Then OpiszMilion = OpiszMilion + " " + o1E6(3)
        Case 2 To 4
                OpiszMilion = OpiszMilion + " " + o1E6(2)
        Case Else
                OpiszMilion = OpiszMilion + " " + o1E6(3)
        End Select
    End If
    OpiszMilion = OpiszMilion + OpiszTysiac(liczba)
End Function

Private Function OpiszTysiac(liczba)
Dim o1E3(3)
o1E3(1) = " tysiąc": o1E3(2) = " tysiące": o1E3(3) = " tysięcy"

Dim s As String
Dim liczba1
    
    liczba1 = liczba
    s = CStr(liczba1)
    If Len(s) > 6 Then s = Right(s, 6)
    s = Left(s, Len(s) - 3)
    liczba1 = CVar(s)
    OpiszTysiac = OpiszSlownie(liczba1)
    If OpiszTysiac <> "" Then
        Select Case liczba1
        Case 1
                If CVar(s) = 1 Then OpiszTysiac = OpiszTysiac + " " + o1E3(1)
                If CVar(s) > 1 Then OpiszTysiac = OpiszTysiac + " " + o1E3(3)
        Case 2 To 4
                OpiszTysiac = OpiszTysiac + " " + o1E3(2)
        Case Else
                OpiszTysiac = OpiszTysiac + " " + o1E3(3)
        End Select
    End If
    OpiszTysiac = OpiszTysiac + OpiszSetki(liczba)

End Function

Private Function OpiszSetki(liczba) As String
Dim s As String
Dim liczba1
    
    liczba1 = liczba
    s = CStr(liczba1)
    If Len(s) > 3 Then s = Right(s, 3)
   ' s = Left(s, Len(s) - 3)
    liczba1 = CVar(s)
    OpiszSetki = OpiszSlownie(liczba1)
    liczba1 = CVar(s)
End Function



Private Function OpiszSlownie(LiczbaSetek) As String
Dim o1do9(10)
Dim o10do19(10)
Dim o20do90(9)
Dim o100do900(9)
o1do9(1) = " jeden":  o1do9(2) = " dwa":   o1do9(3) = " trzy"
o1do9(4) = " cztery": o1do9(5) = " pięć":  o1do9(6) = " sześć"
o1do9(7) = " siedem": o1do9(8) = " osiem": o1do9(9) = " dziewięć"

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

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

o100do900(1) = " sto":       o100do900(2) = " dwieście"
o100do900(3) = " trzysta":   o100do900(4) = " czterysta"
o100do900(5) = " pięćset":   o100do900(6) = " sześćset"
o100do900(7) = " siedemset": o100do900(8) = " osiemset"
o100do900(9) = " dziewięćset"



Dim LiczbaSlownie As String

   ' If LiczbaSetek = 0 Then
    '   OpiszSlownie = " zero"
    '  Exit Function
   ' End If
    
    If (LiczbaSetek >= 100) And (LiczbaSetek <= 999) Then
        LiczbaSlownie = LiczbaSlownie & " " & o100do900(LiczbaSetek \ 100)
        LiczbaSetek = LiczbaSetek Mod 100
    End If

    If (LiczbaSetek >= 20) And (LiczbaSetek <= 99) Then
        LiczbaSlownie = LiczbaSlownie & " " & o20do90(LiczbaSetek \ 10)
        LiczbaSetek = LiczbaSetek Mod 10
    End If
    
    If (LiczbaSetek >= 10) And (LiczbaSetek <= 19) Then LiczbaSlownie = LiczbaSlownie & " " & o10do19(LiczbaSetek - 9)

    If LiczbaSetek < 10 Then LiczbaSlownie = LiczbaSlownie & " " & o1do9(LiczbaSetek)

If LiczbaSlownie = " " Then LiczbaSlownie = ""
OpiszSlownie = LiczbaSlownie

End Function
