Option Explicit


Sub KwotaSlownie()
  
    Dim strSlownie     As String
    strSlownie = InputBox("Podaj cyfrę ...", " Cyfra ...")

    If strSlownie <> "" Then
        If IsNumeric(strSlownie) = False Then Exit Sub
    Else
        Exit Sub
    End If
  
    Dim strWynik      As String
  
    strWynik = strSlownie & " (" & Slownie(L:=strSlownie) & ")"
  
    With Selection
        .InsertAfter " "
        .InsertAfter strWynik
        .InsertAfter " "
        .MoveRight
    End With
End Sub


Public Function Slownie(L) As String
   Dim C            As Currency
   Dim S As String, G As String, Liczba000 As String
   Dim i As Byte, Wynik As String, L1 As Byte, L10 As Byte, L100 As Byte
   If Not IsNumeric(L) Then
      Wynik = "???"
   ElseIf L > 999999999999# Then
      Wynik = "+++"
   ElseIf L < -999999999999# Then
      Wynik = "---"
   Else
      C = CCur(L)
      Wynik = Switch(C < 0, "minus") & ""
      If Fix(C) = 0 Then
         Wynik = Wynik & " " & "zero złotych"
      ElseIf Int(Abs(C)) = 1 Then
         Wynik = Wynik & " " & "jeden złoty"
      Else
         S = Right(Format(Fix(C), "000000000000"), 12)   '----złote
         For i = 0 To 3
            Liczba000 = Mid(S, 3 * i + 1, 3)
            If CInt(Liczba000) = 1 Then
               Wynik = Trim(Wynik) & " " & Trim("jeden " & Choose(i + 1, "miliard", "milion", "tysiąc", "złotych"))
            Else
               L1 = Right(Liczba000, 1)
               L10 = Mid(Liczba000, 2, 1)
               L100 = Left(Liczba000, 1)
               If L1 + L10 + L100 > 0 Then
                  Wynik = Trim(Wynik) & " " & Trim(Stringi("setki", L100) & " " & Stringi("dziesiatki", L10))
                  If L10 = 1 Then
                     Wynik = Trim(Wynik) & " " & Stringi("nastki", L1) & " " & Choose(i + 1, "miliardów", "milionów", "tysięcy", "złotych")
                  Else
                     Wynik = Trim(Wynik) & " " & Trim(Stringi("jednostki", L1) & " " & Stringi("sekcja" & i, L1))
                  End If
               End If
               If (i = 3) And (L10 <> 1) Then Wynik = Trim(Wynik) & " " & Stringi("zlote", Right(S, 1))
            End If
         Next i
      End If
      G = Right(Format(C, "0.00"), 2)   '---grosze
      Wynik = Trim(Wynik) & ", "
         If G = 0 Then
            Wynik = Trim(Wynik) & " zero groszy"
         ElseIf G = 1 Then
            Wynik = Trim(Wynik) & " jeden grosz"
         Else
            If Left(G, 1) = 1 Then
               Wynik = Trim(Wynik) & " " & Stringi("nastki", Right(G, 1)) & " groszy"
            Else
               Wynik = Trim(Wynik) & " " & Trim(Stringi("dziesiatki", Left(G, 1)) & " " & Stringi("jednostki", Right(G, 1)))
               Wynik = Trim(Wynik) & " " & Stringi("grosze", Right(G, 1))
            End If
         End If
   End If
   Slownie = Wynik
End Function


Public Function Stringi(NrStringu As String, Cyfra As Byte)
   Select Case NrStringu
      Case "jednostki"
         Stringi = Choose(Cyfra, "jeden", "dwa", "trzy", "cztery", "pięć", "sześć", "siedem", "osiem", "dziewięć")
      Case "nastki"
         Stringi = Choose(Cyfra + 1, "dziesięć", "jedenaście", "dwanaście", "trzynaście", "czternaście", "piętnaście", "szesnaście", "siedemnaście", "osiemnaście", "dziewiętnaście")
      Case "dziesiatki"
         Stringi = Choose(Cyfra, "", "dwadzieścia", "trzydzieści", "czterdzieści", "pięćdziesiąt", "sześćdziesiąt", "siedemdziesiąt", "osiemdziesiąt", "dziewięćdziesiąt")
      Case "setki"
         Stringi = Choose(Cyfra, "sto", "dwieście", "trzysta", "czterysta", "pięćset", "sześćset", "siedemset", "osiemset", "dziewięćset")
      Case "sekcja2"
         Stringi = Choose(Cyfra + 1, "tysięcy", "tysięcy", "tysiące", "tysiące", "tysiące", "tysięcy", "tysięcy", "tysięcy", "tysięcy", "tysięcy")
      Case "sekcja1"
         Stringi = Choose(Cyfra + 1, "milionów", "milionów", "miliony", "miliony", "miliony", "milionów", "milionów", "milionów", "milionów", "milionów")
      Case "sekcja0"
         Stringi = Choose(Cyfra + 1, "miliardów", "miliardów", "miliardy", "miliardy", "miliardy", "miliardów", "miliardów", "miliardów", "miliardów", "miliardów")
      Case "zlote"
         Stringi = Choose(Cyfra + 1, "złotych", "złotych", "złote", "złote", "złote", "złotych", "złotych", "złotych", "złotych", "złotych")
      Case "grosze"
         Stringi = Choose(Cyfra + 1, "groszy", "groszy", "grosze", "grosze", "grosze", "groszy", "groszy", "groszy", "groszy", "groszy")
   End Select
End Function