Zdravim,
udelal jsem si v excelu pomoci VBA vlastni funkci. Vsecnho chodi OK, ale rad
bych to "optimalizoval", abych se nemusel sam za sebe stydet. Funkce je
ulozena jako XLA, a user musi mit tento doplnek nainstalovan, aby mel danou
funkci k dispozici.
Funkce slouzi k vypoctu kontrolni cislice pro carkovy kod EAN 13.
Vstup do funkce je 5 cislic (mohou zacinat 0, takze string).
Vystup je 13 cislic (3-kod zeme, 4-kod firmy, 5-vstup a 1-kontrolni).
Kod zeme a firmy jsou konstanty, nemeni se.
Vypada to takhle:
Function EAN(Cislo As String)
...
End Function
A ted par otazek:
1. jak docilim toho, aby funkce vratila chybu #HODHOTA,
neco jako: EAN = Error(11)?
vyresil jsem to takhle: EAN = "#HODHOTA"
opticky to sice vypada stejne, ale je to prasarna ;)
2. Jak docilim toho, aby se v pruvodci vlozenim funkce zobrazoval muj
komentar, kdyz user oznaci moji funkci? Za boha to nemohu najit,
porad mi to tam pise "Makro zaznamenane..." Totez bych chtel nastavit
pro vstupni hodnoty (v tomto pripade Cislo).
3. Vlastni vypocet:
mam 12ti mistne cislo, a potrebuji secist cislice na lichych pozicich
a pak na sudych pozicich.
Priklad: 123456789012
a = 1 + 3 + 5 + 7 + 9 + 1
b = 2 + 4 + 6 + 8 + 0 + 2
urcite to jde jednoduse udelat nejakym cyklem, ale ja zaboha nedokazu
ve VBA zjistit, zda je cislo liche... :(
4. Jak nejlepe zaokrouhlit cele cislo na desitky smerem nahoru?
priklad: 81 = 90
83 = 90
89 = 90
80 = 80 (!)
5. Existuji jeste nejake spec. vlastnosti pro XL fce, driv byvalo
neco jako "stale.prepocitavana()", ale bylo to jeste v XL4...?
To je asi vsechno, predem dik za kazdou odpoved.
Jo a ten vzorec pro vypocet je nasledujici:
-----
soucet cifer na lichyh pozicich + (soucet cifer na sudych pozicich * 3)
vysledek je jednociferne cislo, zbyvajici do neblizsiho nasobku 10
-----
Pokud se v tom nekdo chcete stourat, tady je cela ta funkce:
(podotykam, ze se sebou nejsem zrovna moc spokojen :()
----------
Option Explicit
Function EAN(Cislo As String)
Dim EANstart As String
Dim EANwork As String
Dim EANlast As Integer
Dim Licha As Integer
Dim Suda As Integer
' nasledujici hodnota urcuje co je na zacatku EAN
EANstart = 1231234
If Cislo = "" Then 'pokud je prazdna bunka
EAN = ""
ElseIf Len(Cislo) <> 5 Then 'pokud neni delka cisla 5 znaku
EAN = "#HODNOTA"
Else
EANwork = EANstart & Cislo
Licha = 0
Suda = 0
Licha = Licha + Mid(EANwork, 1, 1)
Suda = Suda + Mid(EANwork, 2, 1)
Licha = Licha + Mid(EANwork, 3, 1)
Suda = Suda + Mid(EANwork, 4, 1)
Licha = Licha + Mid(EANwork, 5, 1)
Suda = Suda + Mid(EANwork, 6, 1)
Licha = Licha + Mid(EANwork, 7, 1)
Suda = Suda + Mid(EANwork, 8, 1)
Licha = Licha + Mid(EANwork, 9, 1)
Suda = Suda + Mid(EANwork, 10, 1)
Licha = Licha + Mid(EANwork, 11, 1)
Suda = Suda + Mid(EANwork, 12, 1)
EANlast = Right((Suda * 3) + Licha, 1)
If EANlast = 0 Then
EAN = EANwork & 0
Else
EAN = EANwork & 10 - EANlast
End If
End If
End Function
----------
-pp21-
This archive was generated by hypermail 2.1.2 : 30. 09. 2001, 11:04 CEST