W ubiegłym tygodniu opisałem program do rejestracji zużycia wody w naszym bobowskim Urzędzie Gminy. W ślad za nim musiał powstać bardzo podobny program do rejestracji opłat za odpady komunalne. Podstawowe zadania: maksymalne uproszczenie wprowadzania danych, filtrowanie i sortowanie, archiwizowanie oraz wydruk faktur i zestawień zbiorczych. Program z powodzeniem funkcjonował w bobowskiej administracji kilka kolejnych lat. 900 wierszy kodu i 33000 znaków.

Fragment programu - moja wersja zamiany kwoty liczbowej na słowny odpowiednik:
12345,67 - dwanaście tysięcy trzysta czterdzieści pięć złotych sześćdziesiąt siedem groszy

'   do zamiany cyfry na słownie kwotę
Dim cyfry(1 To 10) As Integer
Dim zł(0 To 100) As Variant
Dim setki(1 To 12) As Variant

'   zamiana liczb na słowa
Sub Słowa()
zł(0) = "zero"
zł(1) = "jeden"
zł(2) = "dwa"
zł(3) = "trzy"
zł(4) = "cztery"
zł(5) = "pięć"
zł(6) = "sześć"
zł(7) = "siedem"
zł(8) = "osiem"
zł(9) = "dziewięć"
zł(10) = "dziesięć"
zł(11) = "jedenaście"
zł(12) = "dwanaście"
zł(13) = "trzynaście"
zł(14) = "czternaście"
zł(15) = "piętnaście"
zł(16) = "szesnaście"
zł(17) = "siedemnaście"
zł(18) = "osiemnaście"
zł(19) = "dziewiętnaście"
zł(20) = "dwadzieścia"
zł(30) = "trzydzieści"
zł(40) = "czterdzieści"
zł(50) = "pięćdziesiąt"
zł(60) = "sześćdziesiąt"
zł(70) = "siedemdziesiąt"
zł(80) = "osiemdziesiąt"
zł(90) = "dziewięćdziesiąt"
'   przypisanie pomiędzy od 1 do 99
For d = 20 To 90 Step 10
    For i = d + 1 To d + 9
        zł(i) = zł(d) & " " & zł(i - d)
    Next i
Next d
setki(1) = "sto"
setki(2) = "dwieście"
setki(3) = "trzysta"
setki(4) = "czterysta"
setki(5) = "pięćset"
setki(6) = "sześćset"
setki(7) = "siedemset"
setki(8) = "osiemset"
setki(9) = "dziewięćset"
End Sub
'   rozdzielenie liczby na cyfry w tablicy
Sub NaCyfry(liczba As Variant)
    l = liczba * 100
    For c = 1 To 10
        reszta = l Mod 10
        cyfry(c) = reszta
        l = (l - reszta) / 10
    Next c
End Sub

Function LiczbaSłownie(liczba As Variant) As Variant
    Słowa 'przydzielenie napisów liczb do tablic
    '   rozdzielenie liczby na cyfry, grosze razem
    ujemna = False
    If liczba < 0 Then
        liczba = -liczba
        ujemna = True
    End If
        
    l = liczba * 100
    For c = 1 To 10
        reszta = l Mod 10
        cyfry(c) = reszta
        l = (l - reszta) / 10
    Next c
    '   a teraz słowa
    groszy = cyfry(2) * 10 + cyfry(1)
    groszysłownie = zł(groszy)
    groszysłownie = groszysłownie & " " & "groszy"
    złotych = cyfry(4) * 10 + cyfry(3)
    If (złotych < 10 Or złotych > 20) And (cyfry(3) = 2 Or cyfry(3) = 3 Or cyfry(3) = 4) Then
        złotychsłownie = zł(złotych) & " złote "
    Else
        złotychsłownie = zł(złotych) & " złotych "
    End If
    If cyfry(5) > 0 Then setkisłownie = setki(cyfry(5))
    t = cyfry(7) * 10 + cyfry(6)
    If t > 0 Then tysiącesłownie = zł(t)
    Select Case t
    Case 0
        tysiącesłownie = ""
    Case 1
        tysiącesłownie = tysiącesłownie & " tysiąc"
    Case 2, 3, 4
        tysiącesłownie = tysiącesłownie & " tysiące"
    Case Else
        tysiącesłownie = tysiącesłownie & " tysięcy"
    End Select
    uj = ""
    If ujemna Then uj = "[minus]"
    LiczbaSłownie = uj & " " & _
                    tysiącesłownie & " " & _
                    setkisłownie & " " & _
                    złotychsłownie & " " & _
                    groszysłownie
End Function

i CAŁOŚĆ dla zainteresowanych. Pominięto oczywiście wszelkie wrażliwe fragmenty odpowiedzialne m.in. za zabezpieczenia.

Wacław Libront