Dziś umieszczę makro do programu Microsoft Excel które umożliwia konwersja zapisu liczbowego na zapis słowny. Poniżej umieszczam kod całego makra oraz plik xla do ściągniecia. Życzę miłego analizowania kodu i jak zwykle czekam na informacje o błędach i ewentualne sugestie na przyszłość.
'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 |
Jeden komentarz