Sub slownie()
' Makro, EXCEL 2007, pasuje do '97, 2010
' Autor: Piotr Müldner-Nieckowski, 2008 r., 2012 r.
' Funkcja pomocnicza wypisywania kwoty faktury słownie
On Error GoTo blad


' Podać nazwy arkuszy, kolumn i wierszy umieszczania wyniku, pobierania danych liczbowych
' usunąć nieistniejące w Twoim arkuszu
' Waluta - może być podmieniona przez stałą, np. "zł" lub pobrana z Twojej tabeli walut

Nazwaark$ = Application.ActiveSheet.Name
If Nazwaark$ = "Faktura VAT" Or Nazwaark$ = "Przegląd dokumentów" Then kol = 2: wierszzl = 40: wierszgr = 41: koldane = 3: wierszdane = 39: waluta = Application.Cells(49, 7): GoTo Obliczenia
If Nazwaark$ = "Paragon" Then kol = 3: wierszzl = 20: wierszgr = 21: koldane = 8: wierszdane = 19: waluta = Application.Cells(32, 6): GoTo Obliczenia
If Nazwaark$ = "Dowód wpłaty" Then kol = 1: wierszzl = 3: wierszgr = 4: koldane = 1: wierszdane = 2: waluta = 1: GoTo Obliczenia
If Nazwaark$ = "Bank. Dowód Wpłaty" Then kol = 3: wierszzl = 19: wierszgr = 20: koldane = 4: wierszdane = 18: waluta = 1: GoTo Obliczenia
If Nazwaark$ = "Przekaz Pocztowy" Then kol = 2: wierszzl = 30: wierszgr = 31: koldane = 3: wierszdane = 29: waluta = 1: GoTo Obliczenia
If Nazwaark$ = "Polecenie Przelewu" Then kol = 5: wierszzl = 30: wierszgr = 33: koldane = 7: wierszdane = 35: waluta = 1: GoTo Obliczenia

If Nazwaark$ = "Nota Memoriałowa" Then Exit Sub

Beep
MsgBox "Jakiś błąd: to nie ten arkusz", 32, "bulll...bull...bul..."
Exit Sub

Obliczenia:
liczbatys = 0
liczba = 0
l = 0
Dim slownie$
slownie$ = ""
waluta1 = Worksheets("Opcje").Cells(12 + waluta, 4)
waluta2 = Worksheets("Opcje").Cells(12 + waluta, 5)

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"

Application.Cells(wierszzl, kol) = slownie$
'Application.Cells(wierszgr, kol) = slownie$
dana = Round(Application.Cells(wierszdane, koldane), 2)

If dana >= 1000000 Then
Beep
'Application.Cells(wierszzl, kol) = "Za duża liczba!"
Application.Cells(wierszzl, kol) = "Za duża liczba! Wprowadź kwotę ręcznie."
'Application.Cells(wierszgr, kol) = "Wprowadź kwotę ręcznie!"
MsgBox "Tak dobrze liczyć nie potrafię!", 16, "Nic z tego!"
Exit Sub
End If

liczba = Int(dana)
liczbagr = Str(Int(((dana - liczba) * 100) + 0.005))

liczbatys = Int(liczba / 1000)
liczba = liczbatys

GoSub Przelicz

If liczbatys = 1 Then slownie$ = slownie$ + " tysiÄ…c ": GoTo Pz
If slownie$ = "" Then GoTo Pz
po = Str$(liczbatys)

py = Right(po, 2)
If py > 11 And py < 15 Then
slownie$ = slownie$ + " tysięcy "
GoTo Pz
End If

py = Right(po, 1)

If py <= 1 Then slownie$ = slownie$ + " tysięcy "
If py >= 5 Then slownie$ = slownie$ + " tysięcy "
If py > 1 And py < 5 Then slownie$ = slownie$ + " tysiÄ…ce "

Pz:
liczba = Int(dana) - (liczbatys * 1000)

GoSub Przelicz

If slownie$ = "" Then
slownie$ = "zero"
End If

If Nazwaark$ = "Faktura VAT" Or Nazwaark$ = "Przegląd dokumentów" Or Nazwaark$ = "Rachunek Uproszczony" Or Nazwaark$ = "Dowód wpłaty" Then
slownie$ = "SÅ‚ownie: " & slownie$
End If

If Len(liczbagr) = 2 Then liczbagr = Replace(liczbagr, " ", "0") 'UWAGA NA TO dodaje zero na poczÄ…tku

slownie$ = slownie$ & " " & waluta1 & " " & liczbagr & " " & waluta2

Application.Cells(wierszzl, kol) = slownie$

Exit Sub

Przelicz:

If liczba = 0 Then GoTo Koniec
l = Int(liczba / 100)
slownie$ = slownie$ + setki(l)

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

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

Koniec:
Return

blad:
MsgBox "Błąd przy przeliczaniu słownie...", , "Błąd!"
Exit Sub

End Sub