Słownie kwotę w złotych Excel v2

Spodobało mi się jeszcze jedno rozwiązanie zatem umieszczam je.

Option Compare Binary 'typ porownania stringów: binarny
Option Explicit 'wymusza deklaracje zmiennych

Function generuj3(ByVal sGrupa3 As String) As String
'***************************************************************
' Pobrano z http://www.bardzki.pl
' -------------------------------
' Mozesz korzystac z ponizszego kodu w dowolnych zastosowaniach
' pod warunkiem pozostawienia tego komentarza.
' Usuniecie komentarza bedzie naruszeniem praw autorskich
' i jest zagrozone sankcjami wynikajacymi z prawa autorskiego
' i praw pokrewnych.
'***************************************************************

Dim Liczebniki_00x 'jednosci, zakres: 0, 1, .. 9
Dim Liczebniki_01x 'nascie, zakres: 10, 11, .. 19
Dim Liczebniki_0x0 'dziesiatki: 20, 30, .. 90
Dim Liczebniki_x00 'setki: 100, 200, .. 900

Dim cTmp1, cTmp2 As String 'cTmp1 - budowany tekst slowny, cTmp2 - zmienna robocza do obsluzenia nastek (10, 11, 12, .. 19)
Dim lNascie As Boolean 'True - jesli kwota zawiera na drugiej (srodkowej) pozycji cyfre "1", czyli np. 10, 11, 12, .. 19

Liczebniki_00x = Array("", "jeden", "dwa", "trzy", "cztery", "pięć", "sześć", "siedem", "osiem", "dziewięć")

Liczebniki_01x = Array("dziesięć", "jedenaście", "dwanaście", "trzynaście", "czternaście", "piętnaście", "szesnaście", "siedemnaście", "osiemnaście", "dziewiętnaście")

Liczebniki_0x0 = Array("", "", "dwadzieścia", "trzydzieści", "czterdzieści", "pięćdziesiąt", "sześćdziesiąt", "siedemdziesiąt", "osiemdziesiąt", "dziewięćdziesiąt")

Liczebniki_x00 = Array("", "sto", "dwieście", "trzysta", "czterysta", "pięćset", "sześćset", "siedemset", "osiemset", "dziewięćset")

'>>> przeliczanie grupy trzech cyfr
cTmp1 = ""
If Len(sGrupa3) = 3 Then 'sa setki
cTmp1 = Liczebniki_x00(CInt(Left(sGrupa3, 1))) & " "
End If

If Len(sGrupa3) >= 2 Then 'sa dziesiatki
cTmp2 = Right(sGrupa3, 2)
If Left(cTmp2, 1) = "1" Then 'jest nascie: 10, 11, .. 19
cTmp1 = cTmp1 & Liczebniki_01x(CInt(Right(cTmp2, 1))) & " "
lNascie = True
Else 'sa dziesiatki: 20, 30, .. 90
cTmp1 = cTmp1 & Liczebniki_0x0(CInt(Left(cTmp2, 1))) & " "
lNascie = False
End If
End If

If (Len(sGrupa3) >= 1) And Not lNascie And (Right(sGrupa3, 1) <> "0") Then 'sa jednosci
cTmp1 = cTmp1 & Liczebniki_00x(CInt(Right(sGrupa3, 1))) & " "
End If
'<<< przeliczanie przeliczanie grupy trzech cyfr generuj3 = cTmp1 End Function Function slownie(ByVal nKwota As Currency) As String '*************************************************************** ' Pobrano z http://www.bardzki.pl ' ------------------------------- ' Mozesz korzystac z ponizszego kodu w dowolnych zastosowaniach ' pod warunkiem pozostawienia tego komentarza. ' Usuniecie komentarza bedzie naruszeniem praw autorskich ' i jest zagrozone sankcjami wynikajacymi z prawa autorskiego ' i praw pokrewnych. '*************************************************************** Dim sSlownie As String 'robocza zmienna,w ktorej bedzie budowany tekst wyrazajacy kwote slownie If nKwota < 1000000 And nKwota >= 0 Then
'tysiace 1000..999000
sSlownie = generuj3(CStr(Int(nKwota / 1000)))
If Len(sSlownie) > 0 Then sSlownie = sSlownie & "tys. "

'jednosci 0..999
sSlownie = sSlownie & generuj3(CStr(Int(nKwota) - Int(nKwota / 1000) * 1000))
If Len(sSlownie) = 0 Then sSlownie = "zero "
sSlownie = sSlownie & "zł "

'grosze
sSlownie = sSlownie & CStr((nKwota - Int(nKwota)) * 100) & "/100"

slownie = sSlownie
Else
slownie = "***** Wartość nie jest obsługiwana *****"
End If

End Function

Źródło: http://www.bardzki.pl

Slownie