Jest to generator kodu kreskowego EAN dla arkusza kalkulacyjnego.
Funkcja generuje kody EAN8, EAN13, EAN13+addon (ISSN,ISBN)
oraz UPC-A jeżeli pierwszą cyfrą kodu będzie "0". (kody EAN są kompatybilne z UPC-A)
Aby kod wyświetlał się poprawnie potrzeba całkowicie darmową
czcionkę barcode którą sam zrobiłem (w załączniku).
Skrypt testowałem u siebie i działa 100% (OOo3.2,win7) ewentualne błędy będę starał się poprawić.
Generowane kody odczytywane były bez problemu przez czytnik PSC QuickScan 1000.
Makro instalujemy metodą "kopiuj wklej" w menadżerze makr OpenOffice .
Działa polecenie EAN(123456789012;12345) .
Pierwszy argument to zawartość kodu liczba lub cyfry, drugi opcjonalny to tzw. add-on 2 lub 5 cyfr.
Jeżeli pierwszy argument nie przekroczy "9999999" + cyfra kontrolna to zostanie wyświetlony kod EAN8.
Jeśli cyfra kontrolna będzie niewłaściwa, wartość zostanie uznana za początek kodu EAN13.
Do małych liczb zostaną dodane zera wiodące.
Aby samemu dodać zera wiodące należy wprowadzać liczby jako tekst.
np: EAN(123) zostanie zapisane jako EAN8=00001236,
EAN("000000000123") zostanie zapisane jako EAN13=0000000001236
i ze względu na pierwsze zero i kompatybilność z UPC-A zostanie doczytany jako UPC-A=000000001236
Cyfra kontrolna nie jest obowiązkowa, zostanie dodana automatycznie.
Jeśli ostatnia 13 cyfra kontrolna zostanie podana i będzie błędna kod nie wyświetli się.
Drugi argument opcjonalny może mieć maksymalnie pięć cyfr.
Jeśli addon nie przekroczy "99" to zostanie wyświetlony addon dwucyfrowy EAN2.
Powyżej "99" zostanie wyświetlony addon pięciocyfrowy EAN5
Generator wraz z czcionką generuje kody typu slim (niskie),
bez cyfr czytelnych dla człowieka, tylko kod kreskowy.
Kod: Zaznacz cały
REM ***** BASIC *****
REM V1.4 14-11-2012
REM Barcode creator EAN by TN
REM Funkcja generuje kod EAN8 , EAN13 i EAN13 + add-on (EAN2,EAN5)
REM
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM
REM ean(znaki cyfr lub liczba; opcjonalnie add-on 2 albo 5 cyfr)
REM
REM ! UWAGA !
REM Do poprawnego działania wymagana jest odpowiednia czcionka barcode.ttf
REM http://user.services.openoffice.org/pl/forum/download/file.php?id=429
REM -----------------------------------------------------------------------------------
Private znak(30) As String
Function ean(optional data$, optional addon$) As String
ean=""
if IsMissing(data) then goto errend
DIM size As Integer
DIM count As Integer 'licznik do pętli
DIM codebar As String
DIM c As Integer 'wygenerowana suma kontrolna
codebar=""
c=0
if data < 1 then goto errend 'przerywa gdy brak danyh
data = CStr (data) 'zmienia liczbe na znaki
size = Len (data) 'liczy ilość znaków
if size=0 then goto errend
if size>13 then goto errend 'przerywa gdy za duzo znakow
for count=1 to size 'przerywa gdy nieobsługiwany znak
if Asc(Mid(data,count,1)) < 48 then goto errend 'przerywa gdy nieobsługiwany znak
if Asc(Mid(data,count,1)) > 57 then goto errend 'przerywa gdy nieobsługiwany znak
Next count
if size<7 then 'dostosowuje dlugosc, dodaje zera wiodace
for count = size to 6
data = "0" & data
Next count
size=7
End if
if size>8 and size<12 then
for count = size to 11
data = "0" & data
Next count
size=12
End if
if size=7 or size=8 then
c = (CInt(Mid(data,1,1))+CInt(Mid(data,3,1))+CInt(Mid(data,5,1))+CInt(Mid(data,7,1)))*3 + (CInt(Mid(data,2,1))+CInt(Mid(data,4,1))+CInt(Mid(data,6,1)))
c = c mod 10
c = 10 - c
if c = 10 then c = 0
end if
if size=8 and c <> CInt(Mid(data,size,1)) then 'jesli zla suma kontrolna EAN8 to EAN13
data = "0000" & data
size = 12
End if
if size=12 or size=13 then
c = 0
for count=1 to 12 step 2
c = c + Mid(data,count,1)
c = c + (CInt(Mid(data,count+1,1))*3)
Next count
c = c mod 10
c = 10 - c
if c = 10 then c = 0
End if
if size=13 and c <> CInt(Mid(data,size,1)) then goto errend 'przerywa gdy zla suma kontrolna EAN13.
initZnak
if size=12 or size=13 then 'jesli EAN13 to
codebar = "HAEA" & znak(Mid(data,2,1))
count = Mid(data,1,1)
if count=0 or count=1 or count=2 or count=3 then codebar = codebar & znak(Mid(data,3,1)) else codebar = codebar & znak(CInt(Mid(data,3,1))+10)
if count=0 or count=4 or count=7 or count=8 then codebar = codebar & znak(Mid(data,4,1)) else codebar = codebar & znak(CInt(Mid(data,4,1))+10)
if count=0 or count=1 or count=4 or count=5 or count=9 then codebar = codebar & znak(Mid(data,5,1)) else codebar = codebar & znak(CInt(Mid(data,5,1))+10)
if count=0 or count=2 or count=5 or count=6 or count=7 then codebar = codebar & znak(Mid(data,6,1)) else codebar = codebar & znak(CInt(Mid(data,6,1))+10)
if count=0 or count=3 or count=6 or count=8 or count=9 then codebar = codebar & znak(Mid(data,7,1)) else codebar = codebar & znak(CInt(Mid(data,7,1))+10)
else
codebar = "HAEA"
for count=1 to 4 'jesli EAN8 to
codebar = codebar & znak(Mid(data,count,1))
Next count
end if
codebar = codebar & "EAEAE" 'sep
if size=12 or size=13 then
for count=8 to 12
codebar = codebar & znak(CInt(Mid(data,count,1))+20)
Next count
else
for count=5 to 7
codebar = codebar & znak(CInt(Mid(data,count,1))+20)
Next count
end if
ean = codebar & znak(c+20) & "AEAH" 'stop
if not IsMissing(addon) and addon<>"" and addon<>"0" then ean = ean & addonf(addon) & "H" 'addon
errend:
End Function
REM---------------------------------------------ADD-ON
Function addonf(add$) As String
addonf=""
DIM size2 As Integer
DIM count2 As Integer
size2 = Len (add) 'liczy ilość znaków
if size2>5 then goto addend 'przerywa gdy za duzo
for count2=1 to size2 'przerywa gdy nieobsługiwany znak
if Asc(Mid(add,count2,1)) < 48 then goto addend 'przerywa gdy nieobsługiwany znak
if Asc(Mid(add,count2,1)) > 57 then goto addend 'przerywa gdy nieobsługiwany znak
Next count2
addonf = "FHAEB" ' margines and start
if size2<3 then 'EAN2
dim addint
addint = CInt(add)
Select Case addint mod 4
Case 0
addonf = addonf & znak(int(addint/10)) & "EA" & znak(addint mod 10)
Case 1
addonf = addonf & znak(int(addint/10)) & "EA" & znak((addint mod 10)+10)
Case 2
addonf = addonf & znak((int(addint/10))+10) & "EA" & znak(addint mod 10)
Case 3
addonf = addonf & znak((int(addint/10))+10) & "EA" & znak((addint mod 10)+10)
End Select
else 'EAN5
if size2=3 then add = "00" & add
if size2=4 then add = "0" & add
DIM add5(5) As Integer
add5(0) = int(mid(add,1,1))
add5(1) = int(mid(add,2,1))
add5(2) = int(mid(add,3,1))
add5(3) = int(mid(add,4,1))
add5(4) = int(mid(add,5,1))
a = add5(0)*3
a = a+add5(1)*9
a = a+add5(2)*3
a = a+add5(3)*9
a = a+add5(4)*3
a = a mod 10
if a<4 then addonf = addonf & znak(add5(0)+10) else addonf = addonf & znak(add5(0))
if a=0 or a=4 or a=7 or a=8 then addonf = addonf & "EA" & znak(add5(1)+10) else addonf = addonf & "EA" & znak(add5(1))
if a=1 or a=4 or a=5 or a=9 then addonf = addonf & "EA" & znak(add5(2)+10) else addonf = addonf & "EA" & znak(add5(2))
if a=2 or a=5 or a=6 or a=7 then addonf = addonf & "EA" & znak(add5(3)+10) else addonf = addonf & "EA" & znak(add5(3))
if a=3 or a=6 or a=8 or a=9 then addonf = addonf & "EA" & znak(add5(4)+10) else addonf = addonf & "EA" & znak(add5(4))
end if
addend:
End Function
REM---------------------------------------------Zestaw znakow
Function initZnak
znak(0) = "GBEA" 'zestaw A
znak(1) = "FBFA"
znak(2) = "FAFB"
znak(3) = "EDEA"
znak(4) = "EAGB"
znak(5) = "EBGA"
znak(6) = "EAED"
znak(7) = "ECEB"
znak(8) = "EBEC"
znak(9) = "GAEB"
znak(10) = "EAFC" 'zestaw B
znak(11) = "EBFB"
znak(12) = "FBEB"
znak(13) = "EAHA"
znak(14) = "FCEA"
znak(15) = "ECFA"
znak(16) = "HAEA"
znak(17) = "FAGA"
znak(18) = "GAFA"
znak(19) = "FAEC"
znak(20) = "CFAE" 'zestaw C
znak(21) = "BFBE"
znak(22) = "BEBF"
znak(23) = "AHAE"
znak(24) = "AECF"
znak(25) = "AFCE"
znak(26) = "AEAH"
znak(27) = "AGAF"
znak(28) = "AFAG"
znak(29) = "CEAF"
End Function
REM---------------------------------------------END
Zestaw czterech funkcji generujących kody UPC .
Funkcja UPCA() generuje kod UPC-A .
Funkcja UPCE() generuje kod UPC-E .
Funkcja UPC_A_E_CONVERT() konwertuje kod UPC-A do UPC-E .
Funkcja EAN_UPC_ADDON() generuje 2 lub 5 cyfrowy dodatek addon.
Każda z funkcji może działać samodzielnie, nie czeba wklejać wszystkich.
Funkcje mogą wspułpracować.
Suma kontrolna nie jest konieczna, zostanie dodana automatycznie.
Jeśli suma kontrolna zostanie podana i będzie błędna kod nie wyświetli się.
Przykłady urzycia:
UPCA(12345678901;EAN_UPC_ADDON(12)) Zostanie wygenerowany kod UPC-A z dwu cyfrowym dodatkiem.
UPCE(UPC_A_E_CONVERT(01230000045);EAN_UPC_ADDON(12)) Zostanie wygenerowany kod UPC-E z dwu cyfrowym dodatkiem.
UPCE(123456;EAN_UPC_ADDON(12345)) Zostanie wygenerowany kod UPC-E z pięcio cyfrowym dodatkiem.
EAN_UPC_ADDON(12345) Zostanie wygenerowany sam dodatek.
UPC_A_E_CONVERT(01230000045) Format kodu UPC-A zostanie przekonwertowany do formatu zgodnego z UPC-E wraz z sumą kontrolną.
Aby konwersja była możliwa kod musi nadawać się do przekształcenia. Pierwszą cyfrą musi być zero, a kod musi zawierać minimum pięć zer.
Generator wraz z czcionką generuje kody typu slim (niskie), bez cyfr czytelnych dla człowieka, tylko kod kreskowy.
Do poprawnego działania wymagana jest odpowiednia czcionka barcode.ttf http://user.services.openoffice.org/pl/ ... php?id=429 (w załączniku)
Kod: Zaznacz cały
REM ***** BASIC *****
REM V1.0 16-08-2012
REM
REM This function generates a UPC-A and UPC-E barcodes + addon.
REM
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM
REM Function UPCA(12345678901) create UPC-A barcode
REM Function UPCE(123456) create UPC-E barcode
REM Function UPC_A_E_CONVERT("01200000456") convert UPC-A to UPC-E format code.
REM Function EAN_UPC_ADDON(12) or EAN_UPC_ADDON(12345) create 2 or 5 digit addon barcode
REM
REM Usage: UPCA(12345678901;EAN_UPC_ADDON(12)) or UPCE(123456;EAN_UPC_ADDON(12))
REM or UPCE(UPC_A_E_CONVERT("01200000456")) etc.
REM
REM All functions are independent.
REM Functions can work together.
REM Checksum is not necessary, will be added automatically.
REM If the checksum is given, and will be incorrect code will not be displayed
REM
REM ! NOTE !
REM For proper operation is required font barcode.ttf free
REM http://user.services.openoffice.org/pl/forum/download/file.php?id=429
REM -----------------------------------------------------------------------------------
Function upca$(optional data$,optional add$)
upca=""
if IsMissing(data) or data="" or data=0 then goto errend
dim size%,c%,check%
size = len(data)
if size>12 then goto errend
for c=1 to size
check = asc(mid(data,c,1))
if check<48 or check>57 then goto errend
next c
if size<11 then data = mid("0000000000",size) & data
size = len(data)
check = 0
for c=1 to 11 step 2
check = check + (cint(mid(data,c,1))*3)
next c
for c=2 to 10 step 2
check = check + cint(mid(data,c,1))
next c
check = 10 - (check mod 10)
if check=10 then check=0
if size=12 and check<>cint(mid(data,12,1)) then goto errend
if size=11 then data = data & check
size = len(data)
dim bar$(9)
bar = array("GBEA","FBFA","FAFB","EDEA","EAGB","EBGA","EAED","ECEB","EBEC","GAEB")
upca="HAEA" 'START
for c=1 to 6
upca = upca & bar(mid(data,c,1))
next c
upca = upca & "EAEAE" ' center
bar = array("CFAE","BFBE","BEBF","AHAE","AECF","AFCE","AEAH","AGAF","AFAG","CEAF")
for c=7 to 12
upca = upca & bar(mid(data,c,1))
next c
upca = upca & "AEAH" ' END
if not IsMissing(add) and add>"" and add>0 then upca = upca & "F" & add ' add the addon
errend:
End Function
rem------------------------------------------- UPCE() Function
Function upce$(optional data$,optional add$)
upce=""
if IsMissing(data) or data="" or data=0 then goto errend
dim size%,c%,tab%(6)
size = len(data)
if size>7 then goto errend
for c=1 to size
tab(6) = asc(mid(data,c,1))
if tab(6)<48 or tab(6)>57 then goto errend
next c
if size<6 then data = mid("00000",size) & data
size = len(data)
for c=1 to size
tab(c-1) = cint(mid(data,c,1))
next c
if tab(5)=0 then c = (tab(1)+tab(2)+tab(4))*3 + (tab(0)+tab(3))
if tab(5)=1 then c = (tab(1)+tab(2)+tab(4))*3 + (tab(0)+tab(3)+1)
if tab(5)=2 then c = (tab(1)+tab(2)+tab(4))*3 + (tab(0)+tab(3)+2)
if tab(5)=3 then c = (tab(1)+tab(4))*3 + (tab(0)+tab(2)+tab(3))
if tab(5)=4 then c = (tab(1)+tab(3)+tab(4))*3 + (tab(0)+tab(2))
if tab(5)>4 then c = (tab(1)+tab(3)+tab(5))*3 + (tab(0)+tab(2)+tab(4))
c = 10 - (c mod 10)
if c=10 then c=0
if size=7 and tab(6)<>c then goto errend
dim bar(19)
bar = array("GBEA","FBFA","FAFB","EDEA","EAGB","EBGA","EAED","ECEB","EBEC","GAEB","EAFC","EBFB","FBEB","EAHA","FCEA","ECFA","HAEA","FAGA","GAFA","FAEC")
upce = "HAEA" & bar(tab(0)+10) ' START & 1 digit
if c<4 then
upce = upce & bar(tab(1)+10)
else
upce = upce & bar(tab(1))
end if
if c=0 or c=4 or c=7 or c=8 then
upce = upce & bar(tab(2)+10)
else
upce = upce & bar(tab(2))
end if
if c=1 or c=4 or c=5 or c=9 then
upce = upce & bar(tab(3)+10)
else
upce = upce & bar(tab(3))
end if
if c=2 or c=5 or c=6 or c=7 then
upce = upce & bar(tab(4)+10)
else
upce = upce & bar(tab(4))
end if
if c=3 or c=6 or c=8 or c=9 then
upce = upce & bar(tab(5)+10)
else
upce = upce & bar(tab(5))
end if
upce = upce & "EAEAEAH" ' END
if not IsMissing(add) and add>"" and add>0 then upce = upce & "F" & add ' add the addon
errend:
End Function
rem------------------------------------------- UPC_A_E_CONVERT() Function
Function upc_a_e_convert$(optional data$)
upc_a_e_convert=""
if IsMissing(data) or data="" or data=0 then goto errend
dim size%,c%,tab%(11)
tab = array(0,0,0,0,0,0,0,0,0,0,0,0)
size = len(data)
if size>12 then goto errend
for c=1 to size
check = asc(mid(data,c,1))
if check<48 or check>57 then goto errend
if size=12 then
tab(11-size+c) = cint(mid(data,c,1))
else
tab(10-size+c) = cint(mid(data,c,1))
end if
next c
check = 0
for c=0 to 10 step 2
check = check + tab(c)*3
next c
for c=1 to 9 step 2
check = check + tab(c)
next c
check = 10 - (check mod 10)
if check=10 then check=0
if size=12 and check<>tab(11) then goto errend
if size=11 then tab(11) = check
if tab(0)<>0 or tab(6)<>0 or tab(7)<>0 then goto errend
if tab(3)=0 and tab(4)=0 and tab(5)=0 then
upc_a_e_convert = tab(1) & tab(2) & tab(8) & tab(9) & tab(10) & "0" & check
elseif tab(3)=1 and tab(4)=0 and tab(5)=0 then
upc_a_e_convert = tab(1) & tab(2) & tab(8) & tab(9) & tab(10) & "1" & check
elseif tab(3)=2 and tab(4)=0 and tab(5)=0 then
upc_a_e_convert = tab(1) & tab(2) & tab(8) & tab(9) & tab(10) & "2" & check
elseif tab(4)=0 and tab(5)=0 and tab(8)=0 then
upc_a_e_convert = tab(1) & tab(2) & tab(3) & tab(9) & tab(10) & "3" & check
elseif tab(5)=0 and tab(8)=0 and tab(9)=0 then
upc_a_e_convert = tab(1) & tab(2) & tab(3) & tab(4) & tab(10) & "4" & check
elseif tab(8)=0 and tab(9)=0 and tab(10)=5 then
upc_a_e_convert = tab(1) & tab(2) & tab(3) & tab(4) & tab(5) & "5" & check
elseif tab(8)=0 and tab(9)=0 and tab(10)=6 then
upc_a_e_convert = tab(1) & tab(2) & tab(3) & tab(4) & tab(5) & "6" & check
elseif tab(8)=0 and tab(9)=0 and tab(10)=7 then
upc_a_e_convert = tab(1) & tab(2) & tab(3) & tab(4) & tab(5) & "7" & check
elseif tab(8)=0 and tab(9)=0 and tab(10)=8 then
upc_a_e_convert = tab(1) & tab(2) & tab(3) & tab(4) & tab(5) & "8" & check
elseif tab(8)=0 and tab(9)=0 and tab(10)=9 then
upc_a_e_convert = tab(1) & tab(2) & tab(3) & tab(4) & tab(5) & "9" & check
end if
errend:
End Function
rem------------------------------------------- EAN_UPC_ADDON() Function
Function ean_upc_addon$(optional data&)
ean_upc_addon=""
if IsMissing(data) or data="" or data<1 or data>99999 then goto errend
dim bar$(19)
bar = array("GBEA","FBFA","FAFB","EDEA","EAGB","EBGA","EAED","ECEB","EBEC","GAEB","EAFC","EBFB","FBEB","EAHA","FCEA","ECFA","HAEA","FAGA","GAFA","FAEC")
ean_upc_addon = "HAEB" 'START
if data<100 then ' 2 digit addon
select case data mod 4
case 0
ean_upc_addon = ean_upc_addon & bar(int(data/10)) & "EA" & bar(data mod 10)
case 1
ean_upc_addon = ean_upc_addon & bar(int(data/10)) & "EA" & bar((data mod 10)+10)
case 2
ean_upc_addon = ean_upc_addon & bar((int(data/10))+10) & "EA" & bar(data mod 10)
case 3
ean_upc_addon = ean_upc_addon & bar((int(data/10))+10) & "EA" & bar((data mod 10)+10)
end select
end if
if data>99 then ' 5 digit addon
data = data + 100000
dim add5%(4),c%
add5 = array(cint(mid(data,2,1)),cint(mid(data,3,1)),cint(mid(data,4,1)),cint(mid(data,5,1)),cint(mid(data,6,1)))
c = (add5(0)+add5(2)+add5(4))*3
c = c + ((add5(1)+add5(3))*9)
c = c mod 10
if c<4 then
ean_upc_addon = ean_upc_addon & bar(add5(0)+10)
else
ean_upc_addon = ean_upc_addon & bar(add5(0))
end if
if c=0 or c=4 or c=7 or c=8 then
ean_upc_addon = ean_upc_addon & "EA" & bar(add5(1)+10)
else
ean_upc_addon = ean_upc_addon & "EA" & bar(add5(1))
end if
if c=1 or c=4 or c=5 or c=9 then
ean_upc_addon = ean_upc_addon & "EA" & bar(add5(2)+10)
else
ean_upc_addon = ean_upc_addon & "EA" & bar(add5(2))
end if
if c=2 or c=5 or c=6 or c=7 then
ean_upc_addon = ean_upc_addon & "EA" & bar(add5(3)+10)
else
ean_upc_addon = ean_upc_addon & "EA" & bar(add5(3))
end if
if c=3 or c=6 or c=8 or c=9 then
ean_upc_addon = ean_upc_addon & "EA" & bar(add5(4)+10)
else
ean_upc_addon = ean_upc_addon & "EA" & bar(add5(4))
end if
end if
ean_upc_addon = ean_upc_addon & "H" 'END
errend:
End Function
Pozdrawiam.