Mam skrypt ściągnięty z netu do konwersji w ekcelu słownie kwoty , niestety z błędem ( autor nie odpowiada). Błędnie konwertuje nst. liczby: 1000 - jeden tysięcy, 12000 - dwanaście tysiące, 13000 - trzynaście tysiące, 14000 - czternaście tysiące ( to samo z milionami, bilionami itp).
Załączam skrypt i proszę szanowne forum o poprawienie i udostepnienie z poprawką.
Z góry dziękuję.
Na dole skrypt:
'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) & " zł " & Format(CDbl(gr), "00") & "/100"
End Function
Po delikatnych przeróbkach tego makra załączam makro do umieszczenia w Excelu. Konwersja liczby na słowa.
