Tworzymy makro dla programu Microsoft Excel

'skrypt sciagniety ze strony www.grzegorzsurowiec.pl
Option Compare Binary 'typ porownania stringów: binarny
Option Explicit 'wymusza deklaracje zmiennych
 
'deklaracja zmiennych
Private Male As Variant
Private Nascie As Variant
Private Duze As Variant
 
'tworzenie metody
'parametr 'l' kwota z akrusza w formacie Currency
 
Function Słownie(ByVal l As Currency) As String
 
 'definicja zmiennych
 Dim S, temp As String
 Dim zl As Currency
 Dim g, i, gr, pos, j, koncowka As Integer
 'zmienna trzyma grupy cyfr -
 'na razie 4: tysiące, miliony, miliardy, biliony
 Dim rozdziel(0 To 3) As Variant
 
 'tworzenie tablic
 Male = Array( _
 Array("", "jeden", "dwa", "trzy", "cztery", "pięć", "sześć", _
 "siedem", "osiem", "dziewięć"), _
 Array("", "", "dwadzieścia", "trzydzieści", "czterdzieści", _
 "pięćdziesiąt", "sześćdziesiąt", "siedemdziesiąt", _
 "osiemdziesiąt", "dziewięćdziesiąt"), _
 Array("", "sto", "dwieście", "trzysta", "czterysta", "pięćset", _
 "sześćset", "siedemset", "osiemset", "dziewięćset") _
 )
 
 Nascie = Array("dziesięć", "jedenaście", "dwanaście", "trzynaście", _
 "czternaście", "piętnaście", "szesnaście", "siedemnaście", _
 "osiemnaście", "dziewiętnaście")
 
 Duze = Array( _
 Array("tysiąc", "tysiące", "tysięcy"), _
 Array("milion", "miliony", "milionów"), _
 Array("miliard", "miliardy", "miliardów"), _
 Array("bilion", "biliony", "bilionów") _
 )
 
 l = WorksheetFunction.Round(l, 2)  'zaokraglamy do groszy
 zl = WorksheetFunction.Floor(l, 1) 'zapisuje czesc całkowitą
 gr = (l - zl) * 100 'zapisujemy grosze
 
 S = CStr(zl) 'zmieniamy kwotę na stringa
 
 'inicjalizacja zmiennych potrzebnych do obsługi pętli
 i = 0
 g = 0
 'inicjuj grupę
 rozdziel(g) = Array(-1, -1, -1)
 
 For pos = Len(S) - 1 To 0 Step -1
 
 'zapisujemy jeden znak do odpowiedniej pozycji w grupie
 rozdziel(g)(i) = CByte(Mid(S, pos + 1, 1))
 
 'tworzymy nową grupę cyfr
 If i = 2 And pos > 0 Then
 g = g + 1 'nowy id grupy
 i = -1 'przy nastepnej petli i = 0
 rozdziel(g) = Array(-1, -1, -1) 'inicjujemy nową grupę
 End If
 
 i = i + 1
 Next
 
 S = "" 'czyscimy zmienna S ktora będzie "zbierała" kwotę słownie
 
 For i = 0 To g
 
 temp = ""
 
 For j = 2 To 0 Step -1 'poruszamy się po grupie od końca
 
 'analizujemy tylko wartości różne od -1
 If rozdziel(i)(j) > -1 Then
 
 If j = 1 Then
 'sprawdzamy czy środkowa cyfra nie jest cyfrą 1
 'aby wywołać tablicę NASCIE
 If rozdziel(i)(j) = 1 Then
 temp = temp & Nascie(rozdziel(i)(0)) & " "
 'czyścimy pierwszą liczbę w grupie bo już nie jest potrzebna
 rozdziel(i)(0) = -1
 Else:
 If rozdziel(i)(j) > 0 Then temp = temp & Male(j)(rozdziel(i)(j)) & " "
 End If
 Else:
 If rozdziel(i)(j) > 0 Then temp = temp & Male(j)(rozdziel(i)(j)) & " "
 End If
 
 End If
 
 Next
 
 'ostatnia cyfra z tysiaca jest zdefiniowana
 If rozdziel(i)(2) > -1 Then
 If i + 1 <= g Then 'jest nastepna grupa cyfr
 'ustalamy koncówkę dla tablicy DUZE
 
 'analizujemy pierwszą cyfrę w kolejnej grupie
 Select Case CByte(rozdziel(i + 1)(0))
 Case 1: koncowka = 0
 Case 2, 3, 4: koncowka = 1
 Case Else: koncowka = 2
 End Select
 
 'analizujemy drugą cyfrę w kolejnej grupie
 If rozdziel(i + 1)(0) = 1 Then
 koncowka = 2
 End If
 
 'jeśli następna grupa nie jest pusta dodaj wartość z tablicy DUZE
 If rozdziel(i + 1)(0) > 0 Or rozdziel(i + 1)(1) > 0 Or _
 rozdziel(i + 1)(2) > 0 Then
 'if i==0
 S = Duze(i)(koncowka) & " " & temp & S
 Else: S = temp & S
 End If
 Else: S = temp & S
End If
 
 Else: S = temp & S
 End If
 
 Next
 
 'wyświetl liczbę słownie
 Słownie = Trim(S) & " " & Format(CDbl(gr), "00") & "/100"
End Function