Excel - zamienianie liczb na kwoty słownie

Otóż dziś znalazłem bardzo przydatny kod do makro w Excelu, który myślę przydać się może każdemu kto musi w Excelu np. stworzyć wzór druku KP, faktury czy wszelkiej innej dokumentacji wykorzystującej kwotę pisaną słownie. Excel nie zawiera takiej funkcji gotowej (moim zdaniem to wielka kicha). Należało więc stworzyć taki programik, który będzie umiał pobierać dane w postaci liczb/walut i w nowych komórkach wydać wynik w postaci słownej. Jak sami możecie sprawdzić makro działa na liczbach od -99 999.99 do 99 999.99 (no ale jeśli ktoś ma obroty większe, obraca większą gotówką, to pewnie stać go na profesjonalny program zamówiony u wyszkolonego informatyka, my szare żuczki musimy radzić sobie inaczej).

Tekst makro jest następujący:

Function Słownie(x As Variant) As String 'dla liczb od -99 999.99 do 99 999.99
If x < 0 Then w = w & "minus "
x = Format(Abs(x), "000 000 000.00"): m = Left(x, 3): t = Mid(x, 5, 3): j = Mid(x, 9, 3): g = "0" & Right(x, 2)
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
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
Select Case j
Case 0
If m = 0 And t = 0 Then w = w & "zero złotych " Else w = w & "złotych "
Case 1
If m = 0 And t = 0 Then w = w & "jeden złoty " Else w = w & "jeden złotych "
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łote " Else w = w & "złotych "
End Select
Select Case g
Case 0
w = w & "zero groszy"
Case 1
w = w & "jeden grosz"
Case Else
w = w & trzy(g)
If Mid(g, 2, 1) <> 1 And (Right(g, 1) = 2 Or Right(g, 1) = 3 Or Right(g, 1) = 4) Then w = w & "grosze" Else w = w & "groszy"
End Select
Słownie = w
End Function
Function trzy(x As Variant) As String
x3 = Val(Left(x, 1)): x2 = Val(Mid(x, 2, 1)): x1 = Val(Right(x, 1))
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 "
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 "
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
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

I teraz jak to działa. Wchodzimy w Excela. Naciskamy skrót Alt+F11. Pojawia nam się okno do Visual Basic. Z menu górnego wybieramy Insert -> Module i wklejamy nasz kod. Zamykamy Visual Basica i teraz możemy uzyskiwać zamienianie wartości z wybranych komórek w nowych po wpisaniu =słownie(np. A5).

Do tego makra należy przypisać jakiś cyfrowy certyfikat bezpieczeństwa, ponieważ jak każde makro może zostać zatrzymane przez Excela po wyłączeniu i włączeniu programu. Ale rzecz przydatna. Ja sobie tekst tego kodu trzymam dla bezpieczeństwa w pliku .txt

Nie pamiętam jak się nazywał autor tego kodu, ale moim zdaniem stworzył coś bardzo przydatnego, co właściwie powinno być w standardowym Excelu.