Klasickým a často řešeným problémem je tvorba mincovní výčetky (mincovky) pro sáčkování výplat. Obvykle je požadována tvorba výčetky pro jednotlivé osoby včetně celkového součtu jednotlivých platidel. Jednou možností řešení je tvorba funkce Mincovka (Částka, Platidlo), která vrací kolik kusů zadaného platidla je potřeba pro vyplacení zadané částky. Pro mincovku je pak potřeba vytvořit dotaz, který vyvolá funkci pro všechna požadovaná platidla, viz obr. 29. Jejich součet pak vytvoříme přímo v tiskové sestavě.
Obr. 29. Zdrojový dotaz pro sestavu s mincovní výčetkou
Zvolené řešení je však značně nepříjemné a proto výpis funkce Mincovka není uveden. Může se totiž snadno stát, že vzniklý dotaz bude díky dalším výpočtům natolik komplikovaný, že systém při otevření sestavy vyhlásí chybu (Query too complex). Samotný zdrojový dotaz přitom často je možno otevřít. Zvýšení složitosti způsobí tvorba součtů jednotlivých platidel v sestavě.
Problém se jeví jako neřešitelný, nebož všechny položky v sestavě potřebujeme. Je tedy třeba změnit celou koncepci tvorby mincovní výčetky. Nový přístup používá funkci MincovkaCela(Částka, Typ), kde hodnota Typ určuje způsob zpracování zadané Částky:
Funkce vrátí nadpis mincovní výčetky a vynuluje proměnné pro součty platidel.
Funkce rozebere zadanou částku a vrátí řetězec s počty jednotlivých platidel, současně zvýší součty.
Funkce vrátí řetězec se součty jednotlivých platidel.
Obr. 30. Použití funkce MincovkaCela ve výstupní sestavě
Použití funkce přímo v tiskové sestavě ukazuje obr. 30. Všimněte si zejména toho, že všechny objekty používající funkci MincovkaCela mají nastaveno písmo Courier New, tedy písmo, které má proporcionální šířku znaků, jinak by se čísla nezařadila do sloupců.
Na obr. 31 vidíme ukázku výsledné tiskové sestavy. Ve výpisu funkce MincovkaCela si všimněte především převodu vstupující částky (desetinné číslo) na celé číslo se kterým se dále pracuje. Tím se řeší problém zaokrouhlovacích chyb při práci přímo s proměnnými datových typů neceločíselných.
Obr. 31. Použití funkce MincovkaCela ve výstupní sestavě
Function MincovkaCela (Suma As Double, Typ As Integer) As String
' *******************************************************
' vrací informaci o tom, kolik mincí (bankovek) je třeba
' pro výplatu částky Suma. Podle čísla Typ vrací:
' 0 - nadpis (jednotlivé hodnoty)
' 1 - rozbor zadané částky
' 2 - součet dříve rozebraných částek
' *******************************************************
On Error GoTo Err_MincovkaCela
Dim V As Variant
MincovkaCela = ""
If IsNull(Typ) Or IsNull(Suma) Then
Exit Function
End If
Dim Su As Long, S As String
' Proměnné pro rozbor aktuální částky
Dim M5000 As Variant, M1000 As Variant
Dim M500 As Variant, M200 As Variant, M100 As Variant
Dim M50 As Variant, M20 As Variant, M10 As Variant
Dim M5 As Variant, M2 As Variant, M1 As Variant
Dim M050 As Variant, M020 As Variant, M010 As Variant
' Proměnné pro součet rozebraných částek
Static S5000 As Variant, S1000 As Variant
Static S500 As Variant, S200 As Variant, S100 As Variant
Static S50 As Variant, S20 As Variant, S10 As Variant
Static S5 As Variant, S2 As Variant, S1 As Variant
Static S050 As Variant, S020 As Variant, S010 As Variant
Select Case Typ
Case 0
S5000 = 0
S1000 = 0
S500 = 0
S200 = 0
S100 = 0
S50 = 0
S20 = 0
S10 = 0
S5 = 0
S2 = 0
S1 = 0
S050 = 0
S020 = 0
S010 = 0
MincovkaCela = " 5000 1000 500 200 100 50 20 10 5 2 1 0,50 0,20 0,10"
Case 1
Su = Suma * 100
S = ""
M5000 = Fix(Su / 500000)
Su = Su - 500000 * M5000
M1000 = Fix(Su / 100000)
Su = Su - 100000 * M1000
M500 = Fix(Su / 50000)
Su = Su - 50000 * M500
M200 = Fix(Su / 20000)
Su = Su - 20000 * M200
M100 = Fix(Su / 10000)
Su = Su - 10000 * M100
M50 = Fix(Su / 5000)
Su = Su - 5000 * M50
M20 = Fix(Su / 2000)
Su = Su - 2000 * M20
M10 = Fix(Su / 1000)
Su = Su - 1000 * M10
M5 = Fix(Su / 500)
Su = Su - 500 * M5
M2 = Fix(Su / 200)
Su = Su - 200 * M2
M1 = Fix(Su / 100)
Su = Su - 100 * M1
M050 = Fix(Su / 50)
Su = Su - 50 * M050
M020 = Fix(Su / 20)
Su = Su - 20 * M020
M010 = Fix(Su / 10)
Su = Su - 10 * M010
S5000 = S5000 + M5000
S1000 = S1000 + M1000
S500 = S500 + M500
S200 = S200 + M200
S100 = S100 + M100
S50 = S50 + M50
S20 = S20 + M20
S10 = S10 + M10
S5 = S5 + M5
S2 = S2 + M2
S1 = S1 + M1
S050 = S050 + M050
S020 = S020 + M020
S010 = S010 + M010
S = S & Right(" " & Str(M5000), 6)
S = S & Right(" " & Str(M1000), 6)
S = S & Right(" " & Str(M500), 6)
S = S & Right(" " & Str(M200), 6)
S = S & Right(" " & Str(M100), 6)
S = S & Right(" " & Str(M50), 6)
S = S & Right(" " & Str(M20), 6)
S = S & Right(" " & Str(M10), 6)
S = S & Right(" " & Str(M5), 6)
S = S & Right(" " & Str(M2), 6)
S = S & Right(" " & Str(M1), 6)
S = S & Right(" " & Str(M050), 6)
S = S & Right(" " & Str(M020), 6)
S = S & Right(" " & Str(M010), 6)
MincovkaCela = S
Case 2
S = S & Right(" " & Str(S5000), 6)
S = S & Right(" " & Str(S1000), 6)
S = S & Right(" " & Str(S500), 6)
S = S & Right(" " & Str(S200), 6)
S = S & Right(" " & Str(S100), 6)
S = S & Right(" " & Str(S50), 6)
S = S & Right(" " & Str(S20), 6)
S = S & Right(" " & Str(S10), 6)
S = S & Right(" " & Str(S5), 6)
S = S & Right(" " & Str(S2), 6)
S = S & Right(" " & Str(S1), 6)
S = S & Right(" " & Str(S050), 6)
S = S & Right(" " & Str(S020), 6)
S = S & Right(" " & Str(S010), 6)
MincovkaCela = S
Case Else
' Byl zadán nesprávný typ
End Select
Exit Function
' *************************************************
' obsluha chyby
' *************************************************
Err_MincovkaCela:
V = MsgBox("Došlo k chybě č. " + Str(Err) + " '" + Error + "'. Informujte autora, jak se Vám to povedlo", 64, "Mincovka")
Resume Next
End Function