Code128 generator, calc, barcode, macro, GS1, GPL .

Gotowe szablony, skrypty, makropolecenia i rozszerzenia. Tutaj możesz pochwalić i podzielić się swoją twórczością z innymi użytkownikami
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

Witam.
Ponieważ nie znalazłem nic podobnego i darmowego,
w ramach edukacji napisałem generator kodów kreskowych dla OpenOffice Calc.
Może komuś jeszcze się przyda.

Jest to generator kodu kreskowego Code128.
Darmowa czcionka : http://user.services.openoffice.org/pl/ ... php?id=429 którą sam zrobiłem.
W tym makro zestaw znaków został przeniesiony do makro.
Eliminuje to problem niewyświetlania się poprawnie wszystkich znaków
w zależności od wersji językowej systemu operacyjnego.
Generator wraz z czcionką generuje kody typu slim (niskie),
bez cyfr czytelnych dla człowieka, tylko kod kreskowy.
Skrypt testowałem u siebie i działa 100% (OOo3.2,win7) ewentualne błędy będę starał się poprawić.
Generowane kody zawierające cyfry , znaki i mieszane odczytywane były bez problemu przez czytnik PSC QuickScan 1000.
Makro instalujemy metodą "kopiuj wklej" w menadżerze makr OpenOffice .

Działa polecenie CODE128("test") lub CODE128("test";0) .
Pierwszy argument to zawartość kodu liczba lub znaki, drugi opcjonalny to wymuszona długość kodu
pomocna przy np numerach seryjnych, dodaje zera wiodące lub przycina od lewej za długi ciąg.
Zero oznacza automatyczną długość .
Kod automatycznie przełącza się po między zastawem znaków B i C co czyni kod zwartym i krótkim.

Kod: Zaznacz cały

REM  *****  BASIC  *****
REM V1.4 14-11-2012
REM Barcode creator code128 by TN
REM Funkcja generuje kod code128 z zestawem znaków B i C.
REM Przełącznie pomiędzy zestawem B i C jest automatyczne
REM co czyni wygenerowany kod optymalnym i zwartym.
REM 
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM 
REM code128(znaki ASCII, cyfry, liczba ; staly wymuszony rozmiar 0=auto size, max=50)
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 weight as integer
Function code128(Optional data$, Optional size%) As String
code128=""
if IsMissing(data) or data="" then goto errend
if IsMissing(size) then size=0
if size > 50 then size = 50	'definiuje długość gdy za durzo
DIM sizedata As Integer
DIM c As Integer
c=0
if data="0" and size=0 then goto errend	'przerywa gdy brak danyh
sizedata = Len(data)	'liczy ilość znaków
if sizedata=0 then goto errend
if sizedata > 50 then		'przycina zbyt długi ciąg
	data = Mid(data,sizedata-49)
	sizedata = 50
end if
if size <> 0 then 			'dostosowuje długość ciągu
	if sizedata < size then	'gdy za krutki
		for c = 1 to size-sizedata
			data = "0" & data
		Next c
	end if
	if sizedata > size then	'gdy za długi
		data = Mid(data,sizedata-size+1)
	end if
end if
sizedata = Len (data)	'liczy ilość znaków
for c=1 to sizedata	'przerywa gdy nieobsługiwany znak
	if Asc(Mid(data,c,1)) < 32 then goto errend	'przerywa gdy nieobsługiwany znak
	if Asc(Mid(data,c,1)) > 126 then goto errend	'przerywa gdy nieobsługiwany znak
Next c

DIM digit as integer
DIM tryb as string
DIM a as integer
DIM checksum as long
DIM p_step as integer
p_step=0
c=1
if check4(data) > 3 then 
	code128 = "HBEAFCF"	'start C 
	tryb = "C"
	checksum = 105
else 
	code128 = "HBEAFAH"	'start B 
	tryb = "B"
	checksum = 104
End if
Do while c<sizedata+1
	digit = check4(mid(data,c))
	if digit > 3 then
		if digit mod 2 <> 0 then digit = digit - 1
		if tryb = "B" then
			code128 = code128 & "AECEDE"	'code C
			p_step=p_step+1	'nastepny znak
			checksum=checksum+(99*p_step)
			tryb = "C"
		End if
		a=c+digit
		Do while c<a
		'-------------------------------------------------------------
			code128 = code128 & znak_c128(cint(mid(data,c,2))+32)
			p_step=p_step+1	'nastepny znak
			checksum=checksum+(weight*p_step)
			c = c + 2
		Loop
	else
		if tryb = "C" then
			code128 = code128 & "AEDECE"	'code B
			p_step=p_step+1	'nastepny znak 
			checksum=checksum+(100*p_step)
			tryb = "B"
		End if
		code128 = code128 & znak_c128(asc(mid(data,c,1)))
		p_step=p_step+1	'nastepny znak
		checksum=checksum+(weight*p_step)
		c = c + 1
	End if
Loop
code128 = code128 & znak_c128((checksum mod 103)+32) & "BGCEAEBH"	'stop
errend:
End Function

Function check4(d1 as string) as integer
	DIM d2 as integer
	DIM d3 as integer
	check4=0
	for d2=1 to Len(d1)
		d3 = asc(mid(d1,d2,1))
		if d3>47 and d3<58 then check4=check4+1
		if d3<48 or d3>57 then Exit For
	Next d2
End Function

Function znak_c128(z128%) as string
Select Case z128
	case 32
	znak_c128 = "BEBFBF"
	weight = 0
	case 33
	znak_c128 = "BFBEBF"
	weight = 1
	case 34
	znak_c128 = "BFBFBE"
	weight = 2
	case 35
	znak_c128 = "AFAFBG"
	weight =  3
	case 36
	znak_c128 = "AFAGBF"
	weight = 4
	case 37
	znak_c128 = "AGAFBF"
	weight = 5
	case 38
	znak_c128 = "AFBFAG"
	weight = 6
	case 39
	znak_c128 = "AFBGAF"
	weight = 7
	case 40
	znak_c128 = "AGBFAF"
	weight = 8
	case 41
	znak_c128 = "BFAFAG"
	weight = 9
	case 42
	znak_c128 = "BFAGAF"
	weight = 10
	case 43
	znak_c128 = "BGAFAF"
	weight = 11
	case 44
	znak_c128 = "AEBFCF"
	weight = 12
	case 45
	znak_c128 = "AFBECF"
	weight = 13
	case 46
	znak_c128 = "AFBFCE"
	weight = 14
	case 47
	znak_c128 = "AECFBF"
	weight = 15
	case 48
	znak_c128 = "AFCEBF"
	weight = 16
	case 49
	znak_c128 = "AFCFBE"
	weight = 17
	case 50
	znak_c128 = "BFCFAE"
	weight = 18
	case 51
	znak_c128 = "BFAECF"
	weight = 19
	case 52
	znak_c128 = "BFAFCE"
	weight = 20
	case 53
	znak_c128 = "BECFAF"
	weight = 21
	case 54
	znak_c128 = "BFCEAF"
	weight = 22
	case 55
	znak_c128 = "CEBECE"
	weight = 23
	case 56
	znak_c128 = "CEAFBF"
	weight = 24
	case 57
	znak_c128 = "CFAEBF"
	weight = 25
	case 58
	znak_c128 = "CFAFBE"
	weight = 26
	case 59
	znak_c128 = "CEBFAF"
	weight = 27
	case 60
	znak_c128 = "CFBEAF"
	weight = 28
	case 61
	znak_c128 = "CFBFAE"
	weight = 29
	case 62
	znak_c128 = "BEBEBG"
	weight = 30
	case 63
	znak_c128 = "BEBGBE"
	weight = 31
	case 64
	znak_c128 = "BGBEBE"
	weight = 32
	case 65
	znak_c128 = "AEAGBG"
	weight = 33
	case 66
	znak_c128 = "AGAEBG"
	weight = 34
	case 67
	znak_c128 = "AGAGBE"
	weight = 35
	case 68
	znak_c128 = "AEBGAG"
	weight = 36
	case 69
	znak_c128 = "AGBEAG"
	weight = 37
	case 70
	znak_c128 = "AGBGAE"
	weight = 38
	case 71
	znak_c128 = "BEAGAG"
	weight = 39
	case 72
	znak_c128 = "BGAEAG"
	weight = 40
	case 73
	znak_c128 = "BGAGAE"
	weight = 41
	case 74
	znak_c128 = "AEBECG"
	weight = 42
	case 75
	znak_c128 = "AEBGCE"
	weight = 43
	case 76
	znak_c128 = "AGBECE"
	weight = 44
	case 77
	znak_c128 = "AECEBG"
	weight = 45
	case 78
	znak_c128 = "AECGBE"
	weight = 46
	case 79
	znak_c128 = "AGCEBE"
	weight = 47
	case 80
	znak_c128 = "CECEBE"
	weight = 48
	case 81
	znak_c128 = "BEAGCE"
	weight = 49
	case 82
	znak_c128 = "BGAECE"
	weight = 50
	case 83
	znak_c128 = "BECEAG"
	weight = 51
	case 84
	znak_c128 = "BECGAE"
	weight = 52
	case 85
	znak_c128 = "BECECE"
	weight = 53
	case 86
	znak_c128 = "CEAEBG"
	weight = 54
	case 87
	znak_c128 = "CEAGBE"
	weight = 55
	case 88
	znak_c128 = "CGAEBE"
	weight = 56
	case 89
	znak_c128 = "CEBEAG"
	weight = 57
	case 90
	znak_c128 = "CEBGAE"
	weight = 58
	case 91
	znak_c128 = "CGBEAE"
	weight = 59
	case 92
	znak_c128 = "CEDEAE"
	weight = 60
	case 93
	znak_c128 = "BFAHAE"
	weight = 61
	case 94
	znak_c128 = "DGAEAE"
	weight = 62
	case 95
	znak_c128 = "AEAFBH"
	weight = 63
	case 96
	znak_c128 = "AEAHBF"
	weight = 64
	case 97
	znak_c128 = "AFAEBH"
	weight = 65
	case 98
	znak_c128 = "AFAHBE"
	weight = 66
	case 99
	znak_c128 = "AHAEBF"
	weight = 67
	case 100
	znak_c128 = "AHAFBE"
	weight = 68
	case 101
	znak_c128 = "AEBFAH"
	weight = 69
	case 102
	znak_c128 = "AEBHAF"
	weight = 70
	case 103
	znak_c128 = "AFBEAH"
	weight = 71
	case 104
	znak_c128 = "AFBHAE"
	weight = 72
	case 105
	znak_c128 = "AHBEAF"
	weight = 73
	case 106
	znak_c128 = "AHBFAE"
	weight = 74
	case 107
	znak_c128 = "BHAFAE"
	weight = 75
	case 108
	znak_c128 = "BFAEAH"
	weight = 76
	case 109
	znak_c128 = "DECEAE"
	weight = 77
	case 110
	znak_c128 = "BHAEAF"
	weight = 78
	case 111
	znak_c128 = "AGDEAE"
	weight = 79
	case 112
	znak_c128 = "AEAFDF"
	weight = 80
	case 113
	znak_c128 = "AFAEDF"
	weight = 81
	case 114
	znak_c128 = "AFAFDE"
	weight = 82
	case 115
	znak_c128 = "AEDFAF"
	weight = 83
	case 116
	znak_c128 = "AFDEAF"
	weight = 84
	case 117
	znak_c128 = "AFDFAE"
	weight = 85
	case 118
	znak_c128 = "DEAFAF"
	weight = 86
	case 119
	znak_c128 = "DFAEAF"
	weight = 87
	case 120
	znak_c128 = "DFAFAE"
	weight = 88
	case 121
	znak_c128 = "BEBEDE"
	weight = 89
	case 122
	znak_c128 = "BEDEBE"
	weight = 90
	case 123
	znak_c128 = "DEBEBE"
	weight = 91
	case 124
	znak_c128 = "AEAEDG"
	weight = 92
	case 125
	znak_c128 = "AEAGDE"
	weight = 93
	case 126
	znak_c128 = "AGAEDE"
	weight = 94
	case 127
	znak_c128 = "AEDEAG"
	weight = 95
	case 128
	znak_c128 = "AEDGAE"
	weight = 96
	case 129
	znak_c128 = "DEAEAG"
	weight = 97
	case 130
	znak_c128 = "DEAGAE"
	weight = 98
	case 131
	znak_c128 = "AECEDE"
	weight = 99
	case 132
	znak_c128 = "AEDECE"
	case 133
	znak_c128 = "CEAEDE"
	case 134
	znak_c128 = "DEAECE"
	Case Else
	znak_c128 = "none"
End Select
End Function

GS1-128 (EAN128) makro dla czcionki BARcoce.
Generator kodów kreskowych dla arkusza kalkulacyjnego OpenOffice Calc.
Darmowa czcionka : http://user.services.openoffice.org/pl/ ... php?id=429 którą sam zrobiłem.
GS1-128 to odmiana kodu128 zaadoptowana na potrzeby organizacji GS1.
Działa polecenie GS1_128(0;123456) .
Pierwszy argument to Identyfikator Zastosowania drugi to wartość.
Można dodać jeszcze drugi Identyfikator Zastosowania i wartość jako trzeci i czwarty argument.
Zostanie wygenerowany wtedy połączony ciąg dwóch kodów GS1.
Generator wraz z czcionką generuje kody typu slim (niskie),
bez cyfr czytelnych dla człowieka, tylko kod kreskowy.

Edit: 06-01-2018. Makro GS1_128 v2.2
Aktualizacja identyfikatorów zastosowania.
Możliwość zsumowania do czterech symbolik i jednym kodzie.

Kod: Zaznacz cały



REM  *****  BASIC  *****
REM V2.2 06-01-2018
REM Barcode creator GS1-128 by TN
REM This function generates a code GS1-128 (EAN128) with a set of characters B and C.
REM Switchable between a set of B and C is automatic.
REM 
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM 
REM Running the command:
REM GS1_128(IZ1 ; Data1 ; IZ2 ; Data2 ; IZ3 ; Data3 ; IZ4 ; Data4)
REM GS1 specification provides the ability to use all ASCII characters.
REM 
REM ! NOTE !
REM For proper operation requires the correct font barcode.ttf
REM http://user.services.openoffice.org/pl/forum/download/file.php?id=429
REM -----------------------------------------------------------------------------------

Function GS1_128$(optional iz1%, optional data1$, optional iz2%, optional data2$, optional iz3%, optional data3$, optional iz4%, optional data4$)
   
   GS1_128="" ' inicjowanie zmiennej
   
   dim iz_size%,fnc1%,pos%,mode%,data_tab%(1 to 48)
   
   fnc1=0
   pos=1
   
   if not IsMissing(iz1) and not IsMissing(data1) and data1<>"" and data1<>"0" then
      if iz1<0 or iz1>9999 then goto errend
      if len(data1)>80 then goto errend
      if iz_set(iz1,iz_size) then goto errend
      if data_set(iz1,data1,iz_size,pos,mode,data_tab) then goto errend
      if iz_size=0 then fnc = 1
   end if
   
   if not IsMissing(iz2) and not IsMissing(data2) and data2<>"" and data1<>"0" then
      if iz2<0 or iz2>9999 then goto errend
      if len(data2)>80 then goto errend
      if fnc=1 then
         data_tab(pos) = 102
         pos = pos + 1
         fnc = 0
      end if
      if iz_set(iz2,iz_size) then goto errend
      if data_set(iz2,data2,iz_size,pos,mode,data_tab) then goto errend
      if iz_size=0 then fnc = 1
   end if
   
   if not IsMissing(iz3) and not IsMissing(data3) and data3<>"" and data1<>"0" then
      if iz3<0 or iz3>9999 then goto errend
      if len(data3)>80 then goto errend
      if fnc=1 then
         data_tab(pos) = 102
         pos = pos + 1
         fnc = 0
      end if
      if iz_set(iz3,iz_size) then goto errend
      if data_set(iz3,data3,iz_size,pos,mode,data_tab) then goto errend
      if iz_size=0 then fnc = 1
   end if
   
   if not IsMissing(iz4) and not IsMissing(data4) and data4<>"" and data1<>"0" then
      if iz4<0 or iz4>9999 then goto errend
      if len(data4)>80 then goto errend
      if fnc=1 then
         data_tab(pos) = 102
         pos = pos + 1
         fnc = 0
      end if
      if iz_set(iz4,iz_size) then goto errend
      if data_set(iz4,data4,iz_size,pos,mode,data_tab) then goto errend
      if iz_size=0 then fnc = 1
   end if
   
   if pos>1 then
      pos = pos - 1
   else
      goto endend:
   end if
   
   dim bar_tab$()
   bartab = array(_
    "BEBFBF","BFBEBF","BFBFBE","AFAFBG","AFAGBF","AGAFBF","AFBFAG","AFBGAF","AGBFAF","BFAFAG",_
    "BFAGAF","BGAFAF","AEBFCF","AFBECF","AFBFCE","AECFBF","AFCEBF","AFCFBE","BFCFAE","BFAECF",_
    "BFAFCE","BECFAF","BFCEAF","CEBECE","CEAFBF","CFAEBF","CFAFBE","CEBFAF","CFBEAF","CFBFAE",_
    "BEBEBG","BEBGBE","BGBEBE","AEAGBG","AGAEBG","AGAGBE","AEBGAG","AGBEAG","AGBGAE","BEAGAG",_
    "BGAEAG","BGAGAE","AEBECG","AEBGCE","AGBECE","AECEBG","AECGBE","AGCEBE","CECEBE","BEAGCE",_
    "BGAECE","BECEAG","BECGAE","BECECE","CEAEBG","CEAGBE","CGAEBE","CEBEAG","CEBGAE","CGBEAE",_
    "CEDEAE","BFAHAE","DGAEAE","AEAFBH","AEAHBF","AFAEBH","AFAHBE","AHAEBF","AHAFBE","AEBFAH",_
    "AEBHAF","AFBEAH","AFBHAE","AHBEAF","AHBFAE","BHAFAE","BFAEAH","DECEAE","BHAEAF","AGDEAE",_
    "AEAFDF","AFAEDF","AFAFDE","AEDFAF","AFDEAF","AFDFAE","DEAFAF","DFAEAF","DFAFAE","BEBEDE",_
    "BEDEBE","DEBEBE","AEAEDG","AEAGDE","AGAEDE","AEDEAG","AEDGAE","DEAEAG","DEAGAE","AECEDE",_
    "AEDECE","CEAEDE","DEAECE","HBEAHAF","HBEAFAH","HBEAFCF","BGCEAEBH")
    '100      101      FNC1      START A  STERT B   START C   STOP
    
   for fnc1=1 to pos
      GS1_128 = GS1_128 & bartab(data_tab(fnc1))
   next fnc1
   
   dim check&
   check = data_tab(1)
   for fnc1=2 to pos
      check = check + data_tab(fnc1)*(fnc1-1)
   next fnc1
   check = check mod 103
   
   GS1_128 = GS1_128 & bartab(check) & bartab(106)   ' STOP
   
   goto endend:
   errend:
   GS1_128 = "err"
   endend:
End Function

Function iz_set%(iz%,iz_size%) ' wyliczenie dlugosci dla znanych identyfikatorow
   iz_set=0 'brak bledu
   iz_size=0 'domyslnie dlugosc automatyczna
   
   'znane stale identyfikatory
   if iz=0 then iz_size = 18 ' Seryjny Numer Jednostki Wysyłkowej (SSCC)
   if iz=1 then iz_size = 14 ' Globalny Numer Jednostki Handlowej (GTIN)
   if iz=2 then iz_size = 14 ' Numer GTIN towarów zawartych w innej jednostce
   if iz=11 then iz_size = 6 ' Data produkcji (RRMMDD)
   if iz=12 then iz_size = 6 ' Data płatności (RRMMDD)	
   if iz=13 then iz_size = 6 ' Data pakowania (RRMMDD)	
   if iz=15 then iz_size = 6 ' Minimalna data trwałości (RRMMDD)	
   if iz=16 then iz_size = 6 ' Maksymalna data sprzedaży (RRMMDD)	
   if iz=17 then iz_size = 6 ' Maksymalna data trwałości (RRMMDD)	
   if iz=20 then iz_size = 2 ' Wariant produktu
   
   ' Logistyka, objętość, Masa, Powierzchnia, wymiary, Długość 
   if iz>=3100 and iz<=3199 then iz_size = 6
   if iz>=3200 and iz<=3379 then iz_size = 6
   if iz>=3400 and iz<=3579 then iz_size = 6
   if iz>=3600 and iz<=3699 then iz_size = 6
   
   if iz=410 then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - wysłać do
   if iz=411 then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - faktura dla
   if iz=412 then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - zakupiono od
   if iz=413 then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - wysłać dla
   if iz=414 then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - identyfikacja lokalizacji fizycznej	
   if iz=415 then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - wystawca faktury
   if iz=424 then iz_size = 3 ' Kraj przetworzenia
   if iz=425 then iz_size = 3 ' Kraj demontażu
   if iz=426 then iz_size = 3 ' Kraj obejmujący cały łańcuch przetwórczy
   if iz=7001 then iz_size = 13 ' Numer zapasów NATO (NSN)	
   if iz=7003 then iz_size = 10 ' Data i czas ważności (RRMMDDhhmm)
   if iz=7006 then iz_size = 6 ' Data pierwszego zamrożenia (RRMMDD)
   if iz=8001 then iz_size = 14 ' Produkty w rolkach – szerokość, długość, średnica rdzenia, kierunek i zwoje
   if iz=8005 then iz_size = 6 ' Cena za jednostkę miary
   if iz=8006 then iz_size = 18 ' Identyfikacja elementów jednostki handlowej GCTIN
   if iz=8017 then iz_size = 18 ' Globalny Numer Relacji Usługowych (GSRN) - świadczeniodawca
   if iz=8018 then iz_size = 18 ' Globalny Numer Relacji Usługowych (GSRN) - świadczeniobiorca
   if iz=8100 then iz_size = 6 ' Rozszerzony kod kupony GS1-128
   if iz=8101 then iz_size = 10 ' Rozszerzony kod kupony GS1-128
   if iz=8102 then iz_size = 2 ' Rozszerzony kody GS1-128
   
   
End Function

Function data_set%(iz%,data$,iz_size%,pos%,mode%,data_tab)
   
   data_set=1 ' flaga bledu
   dim c%,p%,si%,sd%,sa%
   
   si = len(cstr(iz)) ' size of IZ
   sd = len(data) ' size of data
   
   if iz_size=0 then ' size auto
      if si=1 then ' iz min 2
         sa = si + sd + 1
      else ' dlugosc IZ+DATA
         sa = si + sd
      end if
   else ' size const
      if si=1 then ' iz min 2
         sa = si + iz_size + 1 ' IZ 0n
      else ' dlugosc IZ+DATA
         sa = si + iz_size ' si + const size
      end if
   end if
   
   dim tmp_tab%(1 to 100)
   
   ' print IZ
   
   if si=1 then ' size IZ=1
      tmp_tab(1) = 48 ' 0
      tmp_tab(2) = asc(iz) ' (0-9)
      p = 3 ' position
   else
      for c=1 to si
         tmp_tab(c) = asc(mid(iz,c,1))
      next c
      p = si+1 ' position
   end if
   
   ' print data
   if iz_size=0 or sd<=iz_size then ' check data
   
     'if si+sd<iz_size then ' zera wiodace
      if sd<iz_size then ' dodaj zera wiodace
         for c=sd+1 to iz_size
            tmp_tab(p) = 48 ' '0'
            p = p + 1 ' position
         next c
      end if
      
      for c=1 to sd ' print data
         tmp_tab(p) = asc(mid(data,c,1))
         if tmp_tab(p)<32 then goto end_data_set:
         if tmp_tab(p)>126 then goto end_data_set:
         p = p + 1
      next c
      
   else
      goto end_data_set: ' end,err
   end if
   
   for c=1 to sa
      
      if mode=0 then 
         p = 0
         for si=c to sa
            if tmp_tab(si)>47 and tmp_tab(si)<58 then p=p+1
            if tmp_tab(si)<48 or tmp_tab(si)>57 then exit for
         next si
         if p>3 then
            data_tab(1) = 105   ' START C
            mode = 3
         else
            data_tab(1) = 104   ' START B
            mode = 2
         end if
         data_tab(2) = 102   ' FNC1
         pos = 3
      end if
      
      
      p = 0
      for si=c to sa
         if tmp_tab(si)>47 and tmp_tab(si)<58 then p=p+1
         if tmp_tab(si)<48 or tmp_tab(si)>57 then exit for
      next si
      
      if mode=2 and p>3 then
         data_tab(pos) = 99   ' CODE C
         pos = pos + 1
         if pos>48 then goto end_data_set:
         mode = 3
      end if
      
      if mode=3 and p>1 then
         data_tab(pos) = (tmp_tab(c)-48)*10 + (tmp_tab(c+1)-48)
         pos = pos + 1
         c = c + 1
         if pos>48 then goto end_data_set:
      end if
      
      if mode=3 and p<2 then
         data_tab(pos) = 100   ' CODE B
         pos = pos + 1
         if pos>48 then goto end_data_set:
         mode = 2
      end if
      
      if mode=2 and p<4 then
         data_tab(pos) = tmp_tab(c)-32
         pos = pos + 1
         if pos>48 then goto end_data_set:
      end if
   next c

   data_set=0 ' brak bledu
   end_data_set: ' koniec
End Function





Starsze wersje.-----------------------

Makro dla innej czcionki, gdzie zestaw znaków jest zawarty w czcionce.
Aby kod wyświetlał się poprawnie potrzeba czcionkę code128 np stąd:
http://www.dafont.com/code-128.font albo http://www.dafont.com/fr/code-128.font albo http://grandzebu.net/index.php .
Czcionka jest na licencji GPL.
Skrypt testowałem u siebie i działa 100% (OOo3.2,win7) ewentualne błędy będę starał się poprawić.
Generowane kody zawierające cyfry , znaki i mieszane odczytywane były bez problemu przez czytnik PSC QuickScan 1000.
Makro instalujemy metodą "kopiuj wklej" w menadżerze makr OpenOffice .
Działa polecenie CODE128BC("jakis kod";0) .
Pierwszy argument to zawartość kodu liczba lub znaki, drugi to wymuszona długość kodu
pomocna przy np numerach seryjnych, dodaje zera wiodące lub przycina od lewej za długi ciąg.
Zero oznacza automatyczną długość .
Kod automatycznie przełącza się po między zastawem znaków B i C co czyni kod zwartym i krótkim.

Kod: Zaznacz cały

REM  *****  BASIC  *****
REM V1.8 14-11-2012
REM Barcode creator code128bc by TN
REM Funkcja generuje kod code128 z zestawem znaków B i C.
REM Przełącznie pomiędzy zestawem B i C jest automatyczne
REM co czyni wygenerowany kod optymalnym i zwartym.
REM 
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM 
REM code128bc(znaki ascii lub liczba; wymuszona stała długość, 0 = automatyczna długość, max=50)
REM 
REM ! UWAGA !
REM Do poprawnego działania wymagana jest odpowiednia czcionka code128 dostępna na licencji GPL
REM -------------------------------------------------------------------------------------------

Function code128bc(Optional data$, Optional size%) As String
code128bc=""
if IsMissing(data) or data="" then goto errend
if IsMissing(size) then size=0
if size > 49 then size = 50	'definiuje długość gdy za durzo
DIM count As Integer		'licznik do pętli
DIM count2 As integer		'licznik do pętli
DIM sizedata As integer
DIM codebar As String
DIM datastr As String
codebar=""
datastr=""
code128bc=""
if data="0" and size=0 then goto errend	'przerywa gdy brak danyh
datastr = CStr (data)		'zmienia liczbe na znaki
sizedata = Len (datastr)	'liczy ilość znaków
if sizedata=0 then goto errend
if sizedata > 50 then		'przycina zbyt długi ciąg
	count = sizedata - 49
	datastr = Mid(datastr,count)
end if
if size <> 0 then 			'dostosowuje długość ciągu
	if sizedata < size then	'gdy za krutki
		for count = 1 to size-sizedata
			datastr = "0" & datastr
		Next count
	end if
	if sizedata > size then	'gdy za długi
		datastr = Mid(datastr,sizedata-size+1)
	end if
end if
sizedata = Len (datastr)	'liczy ilość znaków
for count=1 to sizedata	'przerywa gdy nieobsługiwany znak
	if Asc(Mid(datastr,count,1)) < 32 then goto errend	'przerywa gdy nieobsługiwany znak
	if Asc(Mid(datastr,count,1)) > 126 then goto errend	'przerywa gdy nieobsługiwany znak
Next count

DIM dc,a As Integer
DIM t As String
for count=1 to sizedata
	dc=0
	For count2 = count to sizedata						' liczy cyfry
		a = asc(mid(datastr,count2,1))
		if a>47 and a<58 then dc=dc+1
		if a<48 or a>57 then Exit For
	Next count2
	if dc>3 then									'jesli 4 cyfry, drukuje
		if dc mod 2 <> 0 then dc=dc-1
		if Len (codebar) = 0 then 
			codebar=Chr(205)		'jesli poczatek , start C
			t = "C"
		else 
			codebar = codebar & Chr(199)					'jeśli nie , Code C
			t = "C"
		end if
		for count2=1 to dc/2			'drukowanie cyfr
			a = Val(Mid(datastr,count,2))+32
			if a>31 and a<127 then
				codebar = codebar & Chr(a)
				count = count + 2
			else
				codebar = codebar & Chr(a+68)
				count = count + 2
			end if
		Next count2
	end if
	if Len (codebar) = 0 then codebar=Chr(204)			'jesli poczatek , Start B
	if sizedata < count then Exit For
	if t="C" then
		codebar = codebar & Chr(200)					' Code B
		t="B"
	end if
	codebar = codebar & Mid(datastr,count,1)
Next count
a = 0
dc = Asc(Mid(codebar,1,1)) - 100
sizedata = Len (codebar)	'liczy ilość znaków
for count=2 to sizedata		'obliczanie sumy kontrolnej
	a = Asc(Mid(codebar,count,1))
	if a < 127 then dc = dc + (a-32)*(count-1)
	if a > 194 then dc = dc + (a-100)*(count-1)
Next count
dc = dc mod 103
if dc<95 then
	codebar = codebar & Chr(dc+32)
else
	codebar = codebar & Chr(dc+100)
end if
code128bc = codebar & Chr(206)
errend:
End Function

Stara wersja makra GS1_128:

Kod: Zaznacz cały

REM  *****  BASIC  *****
REM V1.3 01-08-2012
REM Barcode creator GS1-128 by TN
REM Funkcja generuje kod GS1-128 (EAN128) z zestawem znaków B i C.
REM Przełącznie pomiędzy zestawem B i C jest automatyczne
REM co czyni wygenerowany kod optymalnym i zwartym.
REM 
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM 
REM Działa polecenie:
REM GS1_128(IZ ; wartosc ; IZ2 ; wartosc2)
REM specyfikacja GS1 przewiduje mozliwosc uzycia wszystkich znakow ASCII
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 position as integer
Private checksum as long
Private mode as string
Function GS1_128(optional iz, optional data, optional iz2, optional data2) As String
GS1_128=""
if IsMissing(iz) or IsMissing(data) or iz="" or data="" then goto errend
if iz<1 and data<1 then goto errend	'przerywa gdy brak danyh
data = dataset(iz,data)
if IsMissing(iz2) or IsMissing(data2) or data2="" then
	iz2=0
	data2=0
else
	data2 = dataset(iz2,data2)
	if data2="" then goto errend
	if len(data)+len(data2)>48 then goto errend
end if
if len(data)>48 then goto errend
if check4digit(data)=4 then
	GS1_128 = znak_c128(137)	'Start C
	mode = "C"
else
	GS1_128 = znak_c128(136)	'Start B
	mode = "B"
end if
GS1_128 = GS1_128 & znak_c128(134) & printbar(data)	'FNC1  start gs1-128 data1

if iz2>0 or data2>0 then
	if izset(iz2)=0 then GS1_128 = GS1_128 & znak_c128(134)	'FNC1
	GS1_128 = GS1_128 & printbar(data2)
end if
GS1_128 = GS1_128 & znak_c128((checksum mod 103)+32) & "BGCEAEBH"
errend:
End Function

Sub printbar(printdata as string) as string
	DIM count as integer
	count = 1
	Do while count<=len(printdata)
		if check4digit(mid(printdata,count))=4 then
			if mode="B" then	'set CODE C
				printbar = printbar & znak_c128(131)	'set CODE C
				mode = "C"	'set CODE C
			end if
			Do while check4digit(mid(printdata,count))>1 and count<=len(printdata)
				printbar = printbar & znak_c128(mid(printdata,count,2))
				count = count + 2
			Loop
		else
			if mode="C" then	'set CODE B
				printbar = printbar & znak_c128(132)	'set CODE B
				mode = "B"	'set CODE B
			end if
			printbar = printbar & znak_c128(asc(mid(printdata,count,1)))
			count = count + 1
		end if
	Loop
End Sub

Sub check4digit(d1 as string) as integer
	check4digit = 0
	if d1="" then goto checkexit
	if asc(mid(d1,1,1))>57 or asc(mid(d1,1,1))<48 then goto checkexit
	if len(d1)<2 then goto checkexit
	if asc(mid(d1,2,1))>57 or asc(mid(d1,2,1))<48 then goto checkexit
	check4digit = 2
	if len(d1)<4 then goto checkexit
	if asc(mid(d1,3,1))>57 or asc(mid(d1,3,1))<48 then goto checkexit
	if asc(mid(d1,4,1))>57 or asc(mid(d1,4,1))<48 then goto checkexit
	check4digit = 4				
	checkexit:
End Sub

Sub izset(izs as string) as string
	Select Case mid(izs,1,2)
		case "00"	'20
		izset = 20
		case "01","02","03","41"	'16
		izset = 16
		case "04"	'18
		izset = 18
		case "11","12","13","14","15","16","17","18","19"	'8
		izset = 8
		case "20"	'4
		izset = 4
		case "31","32","33","34","35","36"	'10
		izset = 10
		Case Else
		izset = 0
	End Select
End Sub

Sub dataset(ds_iz, ds_data) as string
	dataset = ""
	ds_iz = CStr(ds_iz)
	if len(ds_iz)=1 then ds_iz = "0" & ds_iz
	if len(ds_iz)>4 then goto dataseterrend
	if izset(ds_iz)=0 and ds_data=0 then goto dataseterrend
	ds_data = CStr(ds_data)
	DIM add0 as string
	DIM dssize as integer
	DIM dssize2 as integer
	add0 = "00000000000000000"
	dssize2 = izset(ds_iz)
	dssize = len(ds_iz) + len(ds_data)
	if dssize2<>0 then
		if dssize>dssize2 then goto dataseterrend
		if dssize<dssize2 then dataset = ds_iz & mid(add0,1,dssize2-dssize) & ds_data
		if dssize=dssize2 then dataset = ds_iz & ds_data
	else
		dataset = ds_iz & ds_data
	end if
	for dssize=1 to len(dataset)
		if Asc(Mid(dataset,dssize,1)) < 32 then 
			dataset = ""	'przerywa gdy nieobsługiwany znak
			goto dataseterrend
		end if
		if Asc(Mid(dataset,dssize,1)) > 126 then 
			dataset = ""	'przerywa gdy nieobsługiwany znak
			goto dataseterrend
		end if
	Next dssize
	dataseterrend:
End Sub

Sub znak_c128(z128) as string
Select Case z128
	case "00" , 32
	znak_c128 = "BEBFBF"
	case "01" , 33
	znak_c128 = "BFBEBF"
	checksum = checksum + (1*position)
	case "02" , 34
	znak_c128 = "BFBFBE"
	checksum = checksum + (2*position)
	case "03" , 35
	znak_c128 = "AFAFBG"
	checksum = checksum + (3*position)
	case "04" , 36
	znak_c128 = "AFAGBF"
	checksum = checksum + (4*position)
	case "05" , 37
	znak_c128 = "AGAFBF"
	checksum = checksum + (5*position)
	case "06" , 38
	znak_c128 = "AFBFAG"
	checksum = checksum + (6*position)
	case "07" , 39
	znak_c128 = "AFBGAF"
	checksum = checksum + (7*position)
	case "08" , 40
	znak_c128 = "AGBFAF"
	checksum = checksum + (8*position)
	case "09" , 41
	znak_c128 = "BFAFAG"
	checksum = checksum + (9*position)
	case "10" , 42
	znak_c128 = "BFAGAF"
	checksum = checksum + (10*position)
	case "11" , 43
	znak_c128 = "BGAFAF"
	checksum = checksum + (11*position)
	case "12" , 44
	znak_c128 = "AEBFCF"
	checksum = checksum + (12*position)
	case "13" , 45
	znak_c128 = "AFBECF"
	checksum = checksum + (13*position)
	case "14" , 46
	znak_c128 = "AFBFCE"
	checksum = checksum + (14*position)
	case "15" , 47
	znak_c128 = "AECFBF"
	checksum = checksum + (15*position)
	case "16" , 48
	znak_c128 = "AFCEBF"
	checksum = checksum + (16*position)
	case "17" , 49
	znak_c128 = "AFCFBE"
	checksum = checksum + (17*position)
	case "18" , 50
	znak_c128 = "BFCFAE"
	checksum = checksum + (18*position)
	case "19" , 51
	znak_c128 = "BFAECF"
	checksum = checksum + (19*position)
	case "20" , 52
	znak_c128 = "BFAFCE"
	checksum = checksum + (20*position)
	case "21" , 53
	znak_c128 = "BECFAF"
	checksum = checksum + (21*position)
	case "22" , 54
	znak_c128 = "BFCEAF"
	checksum = checksum + (22*position)
	case "23" , 55
	znak_c128 = "CEBECE"
	checksum = checksum + (23*position)
	case "24" , 56
	znak_c128 = "CEAFBF"
	checksum = checksum + (24*position)
	case "25" , 57
	znak_c128 = "CFAEBF"
	checksum = checksum + (25*position)
	case "26" , 58
	znak_c128 = "CFAFBE"
	checksum = checksum + (26*position)
	case "27" , 59
	znak_c128 = "CEBFAF"
	checksum = checksum + (27*position)
	case "28" , 60
	znak_c128 = "CFBEAF"
	checksum = checksum + (28*position)
	case "29" , 61
	znak_c128 = "CFBFAE"
	checksum = checksum + (29*position)
	case "30" , 62
	znak_c128 = "BEBEBG"
	checksum = checksum + (30*position)
	case "31" , 63
	znak_c128 = "BEBGBE"
	checksum = checksum + (31*position)
	case "32" , 64
	znak_c128 = "BGBEBE"
	checksum = checksum + (32*position)
	case "33" , 65
	znak_c128 = "AEAGBG"
	checksum = checksum + (33*position)
	case "34" , 66
	znak_c128 = "AGAEBG"
	checksum = checksum + (34*position)
	case "35" , 67
	znak_c128 = "AGAGBE"
	checksum = checksum + (35*position)
	case "36" , 68
	znak_c128 = "AEBGAG"
	checksum = checksum + (36*position)
	case "37" , 69
	znak_c128 = "AGBEAG"
	checksum = checksum + (37*position)
	case "38" , 70
	znak_c128 = "AGBGAE"
	checksum = checksum + (38*position)
	case "39" , 71
	znak_c128 = "BEAGAG"
	checksum = checksum + (39*position)
	case "40" , 72
	znak_c128 = "BGAEAG"
	checksum = checksum + (40*position)
	case "41" , 73
	znak_c128 = "BGAGAE"
	checksum = checksum + (41*position)
	case "42" , 74
	znak_c128 = "AEBECG"
	checksum = checksum + (42*position)
	case "43" , 75
	znak_c128 = "AEBGCE"
	checksum = checksum + (43*position)
	case "44" , 76
	znak_c128 = "AGBECE"
	checksum = checksum + (44*position)
	case "45" , 77
	znak_c128 = "AECEBG"
	checksum = checksum + (45*position)
	case "46" , 78
	znak_c128 = "AECGBE"
	checksum = checksum + (46*position)
	case "47" , 79
	znak_c128 = "AGCEBE"
	checksum = checksum + (47*position)
	case "48" , 80
	znak_c128 = "CECEBE"
	checksum = checksum + (48*position)
	case "49" , 81
	znak_c128 = "BEAGCE"
	checksum = checksum + (49*position)
	case "50" , 82
	znak_c128 = "BGAECE"
	checksum = checksum + (50*position)
	case "51" , 83
	znak_c128 = "BECEAG"
	checksum = checksum + (51*position)
	case "52" , 84
	znak_c128 = "BECGAE"
	checksum = checksum + (52*position)
	case "53" , 85
	znak_c128 = "BECECE"
	checksum = checksum + (53*position)
	case "54" , 86
	znak_c128 = "CEAEBG"
	checksum = checksum + (54*position)
	case "55" , 87
	znak_c128 = "CEAGBE"
	checksum = checksum + (55*position)
	case "56" , 88
	znak_c128 = "CGAEBE"
	checksum = checksum + (56*position)
	case "57" , 89
	znak_c128 = "CEBEAG"
	checksum = checksum + (57*position)
	case "58" , 90
	znak_c128 = "CEBGAE"
	checksum = checksum + (58*position)
	case "59" , 91
	znak_c128 = "CGBEAE"
	checksum = checksum + (59*position)
	case "60" , 92
	znak_c128 = "CEDEAE"
	checksum = checksum + (60*position)
	case "61" , 93
	znak_c128 = "BFAHAE"
	checksum = checksum + (61*position)
	case "62" , 94
	znak_c128 = "DGAEAE"
	checksum = checksum + (62*position)
	case "63" , 95
	znak_c128 = "AEAFBH"
	checksum = checksum + (63*position)
	case "64" , 96
	znak_c128 = "AEAHBF"
	checksum = checksum + (64*position)
	case "65" , 97
	znak_c128 = "AFAEBH"
	checksum = checksum + (65*position)
	case "66" , 98
	znak_c128 = "AFAHBE"
	checksum = checksum + (66*position)
	case "67" , 99
	znak_c128 = "AHAEBF"
	checksum = checksum + (67*position)
	case "68" , 100
	znak_c128 = "AHAFBE"
	checksum = checksum + (68*position)
	case "69" , 101
	znak_c128 = "AEBFAH"
	checksum = checksum + (69*position)
	case "70" , 102
	znak_c128 = "AEBHAF"
	checksum = checksum + (70*position)
	case "71" , 103
	znak_c128 = "AFBEAH"
	checksum = checksum + (71*position)
	case "72" , 104
	znak_c128 = "AFBHAE"
	checksum = checksum + (72*position)
	case "73" , 105
	znak_c128 = "AHBEAF"
	checksum = checksum + (73*position)
	case "74" , 106
	znak_c128 = "AHBFAE"
	checksum = checksum + (74*position)
	case "75" , 107
	znak_c128 = "BHAFAE"
	checksum = checksum + (75*position)
	case "76" , 108
	znak_c128 = "BFAEAH"
	checksum = checksum + (76*position)
	case "77" , 109
	znak_c128 = "DECEAE"
	checksum = checksum + (77*position)
	case "78" , 110
	znak_c128 = "BHAEAF"
	checksum = checksum + (78*position)
	case "79" , 111
	znak_c128 = "AGDEAE"
	checksum = checksum + (79*position)
	case "80" , 112
	znak_c128 = "AEAFDF"
	checksum = checksum + (80*position)
	case "81" , 113
	znak_c128 = "AFAEDF"
	checksum = checksum + (81*position)
	case "82" , 114
	znak_c128 = "AFAFDE"
	checksum = checksum + (82*position)
	case "83" , 115
	znak_c128 = "AEDFAF"
	checksum = checksum + (83*position)
	case "84" , 116
	znak_c128 = "AFDEAF"
	checksum = checksum + (84*position)
	case "85" , 117
	znak_c128 = "AFDFAE"
	checksum = checksum + (85*position)
	case "86" , 118
	znak_c128 = "DEAFAF"
	checksum = checksum + (86*position)
	case "87" , 119
	znak_c128 = "DFAEAF"
	checksum = checksum + (87*position)
	case "88" , 120
	znak_c128 = "DFAFAE"
	checksum = checksum + (88*position)
	case "89" , 121
	znak_c128 = "BEBEDE"
	checksum = checksum + (89*position)
	case "90" , 122
	znak_c128 = "BEDEBE"
	checksum = checksum + (90*position)
	case "91" , 123
	znak_c128 = "DEBEBE"
	checksum = checksum + (91*position)
	case "92" , 124
	znak_c128 = "AEAEDG"
	checksum = checksum + (92*position)
	case "93" , 125
	znak_c128 = "AEAGDE"
	checksum = checksum + (93*position)
	case "94" , 126
	znak_c128 = "AGAEDE"
	checksum = checksum + (94*position)
	case "95" , 127
	znak_c128 = "AEDEAG"
	checksum = checksum + (95*position)
	case "96" , 128
	znak_c128 = "AEDGAE"
	checksum = checksum + (96*position)
	case "97" , 129
	znak_c128 = "DEAEAG"
	checksum = checksum + (97*position)
	case "98" , 130
	znak_c128 = "DEAGAE"
	checksum = checksum + (98*position)
	case "99" , 131
	znak_c128 = "AECEDE"	'CODE C
	checksum = checksum + (99*position)
	case 132
	znak_c128 = "AEDECE"	'CODE B
	checksum = checksum + (100*position)
	case 133
	znak_c128 = "CEAEDE"	'CODE A
	checksum = checksum + (101*position)
	case 134
	znak_c128 = "DEAECE"	'FNC1
	checksum = checksum + (102*position)
	case 135
	znak_c128 = "HBEAHAF"	'Start A
	checksum = 103
	position = 0
	case 136
	znak_c128 = "HBEAFAH"	'Start B
	checksum = 104
	position = 0
	case 137
	znak_c128 = "HBEAFCF"	'Start C
	checksum = 105
	position = 0
	Case Else
	znak_c128 = "none"
End Select
position = position + 1
End Sub

Pozdrawiam.
Załączniki
BARcode_v2.zip
Czcionka BARcode dla makra CODE128.
(5.86 KiB) Pobrany 801 razy
Ostatnio zmieniony pn sty 08, 2018 2:51 pm przez OOoUser46, łącznie zmieniany 20 razy.
MrTN. OOo 3.3 , Win7 .
Awatar użytkownika
quest-88
Posty: 1105
Rejestracja: ndz maja 24, 2009 8:12 pm
Lokalizacja: Zabrze
Kontakt:

Re: Code128 generator, calc, barcode, macro .

Post autor: quest-88 »

Super, zawsze miło jest mieć coś nowego w zasobach. :-)

A patrzyłeś może na ten artykuł?
http://openofficeorgpl.blogspot.com/201 ... ceorg.html
Standardowa diagnostyka rozwiązuje 90% problemów typu "wcześniej działało, ale już nie działa".
Przepis na LibreOffice
Uzyskałeś pomoc? Poinformuj innych o sprawdzonym rozwiązaniu i podziękuj. Dodaj [SOLVED] w tytule.
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro .

Post autor: OOoUser46 »

quest-88 pisze:Super, zawsze miło jest mieć coś nowego w zasobach. :-)

A patrzyłeś może na ten artykuł?
http://openofficeorgpl.blogspot.com/201 ... ceorg.html
Tak. Patrzyłem .
Ten generator działa w OOo DRAW i trzeba ręcznie wpisywać każdą wartość.
W przypadku hurtowego generowania setek tysięcy kodów np: numer seryjny produktu,
lub zarządzania i drukowania np zasobów dużego magazynu ręczne wpisywanie każdego kodu jest dość kłopotliwe.
Poza tym w arkuszu kalkulacyjnym taki kod może być dynamiczny i zawierać np: dzisiejszą datę , godzinę lub na bieżąco ilość danego produktu.

Dziękuje za odpowiedź.
Pozdrawiam.
MrTN. OOo 3.3 , Win7 .
srodek_86
Posty: 7
Rejestracja: pn cze 11, 2012 3:33 pm

Re: Code128 generator, calc, barcode, macro, GPL .

Post autor: srodek_86 »

Witam
Jestem zainteresowany tworzeniem kodów z użyciem GS-1 128. Przyda mi się w moim arkuszu w exel. Daj znac jak przebiegają Ci prace, będę bardzo wdzięczny, ponieważ nic nie moge znaleśc na internecie na temat gs-1 128. Jeżeli chodzi o ean 128 to znalazłem kilka dodatków. Ale dla samego kodu gs-128 niestety mi sie nie udało.
Pozdrawiam i życze powodzenia w tworzeniu modułu.
LibreOffice na Windows Vista / LibreOffice Ubuntu 12.04
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GPL .

Post autor: OOoUser46 »

srodek_86 pisze:Witam
Jestem zainteresowany tworzeniem kodów z użyciem GS-1 128.....
Witam.
Dodałem nowe makro GS1_128() .
Mam nadzieje że będzie użyteczne.
Ewentualne błędy będę się starał poprawić.

Pozdrawiam.
MrTN. OOo 3.3 , Win7 .
srodek_86
Posty: 7
Rejestracja: pn cze 11, 2012 3:33 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: srodek_86 »

Wielkie dzięki. Moduł chodzi bardzo sprawnie. Tylko jeszcze musze troszkę czcionkę przerobic, żeby dostosowac do wymogów poczty.
Pozdrawiam
LibreOffice na Windows Vista / LibreOffice Ubuntu 12.04
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

srodek_86 pisze:...... Tylko jeszcze musze troszkę czcionkę przerobic, żeby dostosowac do wymogów poczty.
Pozdrawiam
Czcionkę robiłem w kreatorze online: http://fontstruct.com/ .
Wąski pasek (litera A) ma szerokość 2px i wysokość 51px,
drugi pasek (litera B) ma szerokość 4px i wysokość 51px itd.
Litery "ABCD" czarne paski, "EFGH" białe paski.
Dodatkowo dla innych makr litery "N" 2px na 51px i "W" 5px na 51px.
Litery "NW" czarne paski, "nw" białe paski.
Będziesz miał jakiś punkt odniesienia przy edycji.
Pozdrawiam.
MrTN. OOo 3.3 , Win7 .
srodek_86
Posty: 7
Rejestracja: pn cze 11, 2012 3:33 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: srodek_86 »

Dzięki wielkie to mi pomoże w edycji. Potrzebuje tylko zwiększyc wysokośc 2 krotnie. Wtedy przy czcionce 39 szerokośc bedzie odpowiadała wysokości i wymaganią poczty. Ja sciagnałem sobie FontForge na ubuntu.
LibreOffice na Windows Vista / LibreOffice Ubuntu 12.04
srodek_86
Posty: 7
Rejestracja: pn cze 11, 2012 3:33 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: srodek_86 »

Czcionkę robiłem w kreatorze online: http://fontstruct.com/ .
Wąski pasek (litera A) ma szerokość 2px i wysokość 51px,
drugi pasek (litera B) ma szerokość 4px i wysokość 51px itd.
Litery "ABCD" czarne paski, "EFGH" białe paski.
Dodatkowo dla innych makr litery "N" 2px na 51px i "W" 5px na 51px.
Litery "NW" czarne paski, "nw" białe paski.
Będziesz miał jakiś punkt odniesienia przy edycji.
Pozdrawiam.
Powiedz mi jeszcze jak w fontstruct zrobic białe odstepy? bo zdecydowałem sie na ten program
LibreOffice na Windows Vista / LibreOffice Ubuntu 12.04
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

srodek_86 pisze: Powiedz mi jeszcze jak w fontstruct zrobic białe odstepy? bo zdecydowałem sie na ten program
He he. Też miałem ten problem.
Ja zrobiłem to w taki sposób, że przy 'Baseline' zaraz na początku czcionki zrobiłem możliwie najmniejszą kropkę,
aby program nie uznał znaku za pusty, a szerokość uzyskałem klikając na MENU > VIEW > LITTER WIDTH.
Wtedy pojawia się zielona linia Width i nią ustalamy szerokość paska.
Oczywiście w przypadku białych pasków wysokość jest bez znaczenia.
Podczas zapisu/podglądu gdy będzie dostępna opcja SPACING musi być ustawiona na GLOBAL "0" (zero).
Powodzenia. Daj znać jak poszło ;)
MrTN. OOo 3.3 , Win7 .
srodek_86
Posty: 7
Rejestracja: pn cze 11, 2012 3:33 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: srodek_86 »

Udało się:) Mam czcionke już dostosowaną do wymogów poczty. Bardzo mi się przydały twoje dane. Podniosłem ją do 100 px i jest ok. W poniedziałek sprawdzę na poczcie na skanerze jak działają kody, ale jestem pewien że będzie dobrze, bo idealnie sie pokrywają. Dzięki za wszystko bardzo ułatwiłeś mi życie. A mam pytanie orientujesz się może jak działa makro na wysyłanie poczty z calc?
Ostatnio zmieniony ndz cze 17, 2012 11:42 pm przez Jan_J, łącznie zmieniany 1 raz.
Powód: Podział wątku. Bardzo proszę utrzymywać spójność tematyczną wątków.
LibreOffice na Windows Vista / LibreOffice Ubuntu 12.04
dj55
Posty: 1
Rejestracja: śr lip 18, 2012 11:14 am

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: dj55 »

Witam

Próbuje przełożyć twoje makra na Crystal Reports i powiedzmy, że mi się udało. Natomiast pojawił się problem jeżeli zacząłem konwertować ciekawsze rzeczy. Twoje makra mają problem na przykład z takim kodem: 119/2012 b30.26t9.18 , zapiszą go w kreskowy natomiast skaner już nie odczyta.
Zaznaczę, że błąd jest w miejscu

Kod: Zaznacz cały

 
for count2=1 to dc/2        
   a = Val(Mid(datastr,count1,2))+32   
    if a>31 and a<127 then
    codebar = codebar & Chr(a) //Przepełnienie wartości liczbowej
   count1 = count1 + 2
   else
   codebar = codebar & Chr(a+68)
   count1 = count1 + 2
   end if
Next count2
Pozdrawiam
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

dj55 pisze:Witam
Próbuje przełożyć twoje makra na Crystal Reports i powiedzmy, że mi się udało. Natomiast pojawił się problem ........
Witam.
Znalazłem problem.
Błąd znajdował się w miejscu w którym funkcja ustalała czy cztery kolejne znaki to cyfry i czy zmienić zestaw znaków.
Z powodu błędu znak "/" był traktowany jako cyfra.
Problem dotyczył makra CODE128BC() czcionka code128 i CODE128() czcionka BARcode.
Makra już zostały poprawione.
Wartość "119/2012 b30.26t9.18" drukuje się prawidłowo i jest czytana przez mój czytnik PSC QuickScan 1000.
Nie znalazłem błędu przepełnienia dla zmiennej "codebar". Zaznaczam, że ta zmienna jest typu STRING a nie INTEGER.
Być może została błędnie przekonwertowana.
Jako ciekawostkę dodam , że przed poprawą mój czytnik czytał taki kod lecz zwracał "11092012 b30006t9.18" .

Kod: Zaznacz cały

for count=1 to sizedata
   dc=0
   For count2 = count to sizedata                  
      a = asc(mid(datastr,count2,1))
      if a>47 and a<58 then dc=dc+1
      if a<48 or a>57 then Exit For    ' <<<---  BŁĄD  zamiast 48 było 46  !!!!!!!!!
   Next count2
   if dc>3 then                           
Pozdrawiam.
I dziękuje za zainteresowanie.
MrTN. OOo 3.3 , Win7 .
m0nia
Posty: 3
Rejestracja: wt lis 13, 2012 2:43 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: m0nia »

Witam
Pozwoliłam sobie skorzystać z załacznych przez Pana makr. niestety przy pierwszym(code 128bc) makro się uruchamia ale nie wszystkie kody sa poprawne - mimo zastosowania odpowiedniej czcionki. Przy drugim Code128 otzrymuje błąd - pewnie robię coś nie tak:
ByRef argument type mismatch.
----------------
If check4(data) > 3 Then
-------------------
Czy moge prosic o jakas wskazówkę. będe wdzięczna.
OpenOffice 3.1
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

m0nia pisze:Witam .............
Witam.
Wprowadziłem drobną korektę do makr CODE128BC i CODE128 , która mogła powodować ten błąd.
Ale problemem może być co innego.
Miał bym parę pytań:

Jaki arkusz kalkulacyjny używasz i w jakiej wersji ?
Ja testowałem makra pod OpenOffice.org 3.3.0 i LibreOffice 3.5.5.3 .

Czy każdy kod nie działa, czy tylko niektóre.
Jeżeli część kodów działa a część nie proszę podać kilka tych co nie działają.

Proszę sprawdzić czy np. takie polecenie działa CODE128("test")
Być może wprowadzanie są jakieś znaki których kod nie obsługuje.
Najlepiej wprowadzać wartość jako tekst.

Pozdrawiam.
MrTN. OOo 3.3 , Win7 .
m0nia
Posty: 3
Rejestracja: wt lis 13, 2012 2:43 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: m0nia »

Witam
Mam V.3.3.0. Przekopiowałam makro code128bc jeszcze raz i już działa ok. Dziękuję. Ale nasuwa mi sie jeszcze jedno pytanie. Próbowałam to makro wkleić do excela i nie działają niektóre kody, np: 1234567892 ,1234567895. Natomiast 1234567890 działa. Czy wiesz może dlaczego?
OpenOffice 3.1
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

m0nia pisze:Witam
Mam V.3.3.0. Przekopiowałam makro code128bc jeszcze raz i już działa ok. Dziękuję. Ale nasuwa mi sie jeszcze jedno pytanie. Próbowałam to makro wkleić do excela i nie działają niektóre kody, np: 1234567892 ,1234567895. Natomiast 1234567890 działa. Czy wiesz może dlaczego?
Zmodyfikowałem nieco makra CODE128 i CODE128BC.
Powinny lepiej działać na Excelu.
Proponuje używać makra CODE128 i czcionki BarCode.
Ponieważ z czcionką do makra CODE128BC czasem jest taki problem,
że niektóre znaki zamiast wyświetlać paski to pojawiają się zwykłe literki.
Makro CODE128 też ma w sobie zestaw znaków B i C.

Pozdrawiam.
MrTN. OOo 3.3 , Win7 .
m0nia
Posty: 3
Rejestracja: wt lis 13, 2012 2:43 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: m0nia »

Ogroniaste dzięki . Bardzo mi pomogłeś.
OpenOffice 3.1
pherman
Posty: 1
Rejestracja: czw maja 30, 2013 12:31 am

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: pherman »

Witam

Mam problem z uruchomieniem tego macra i barcodu.

Chcę go uruchomić w Office 2010
Przy użyciu czcionki Code 128 - barcod niby jest ale po zmianie symboli z kodem nic się nie dzieje
Natomiast przy czcionce Barcode - są dziwne znaki.


Proszę o pomoc.

Potrzebuje z tego typu ciągu znaków wyciągnąć do barcoda np.
%00333000260238510724B113616

chcę uzyskać takie znaki (pogrubiona czcionka)
Załączniki
Bez tytułu.jpg
code128bc.jpg
code128bc.jpg (5.1 KiB) Przejrzano 54293 razy
OpenOffice 3.1 na Windows 7
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

Witam.

Właśnie testowałem makra na Office 2010, WIN732bit.
Z pierwszym makrem, a właściwie czcionką do niego jest taki problem, że nie wszystkie znaczki się wyświetlają.
Ale to zależy od programu np. WordPad wyświetla a Office nie.
Nie bardzo jest na to rada, być może znaczenie ma wersja językowa systemu operacyjnego.

Dlatego napisałem drugie makro CODE128 i specjalną czcionkę dla niego BARcoce.
Wklej do Excela tylko drugie makro i użyj polecenia =CODE128("%00333000260238510724B113616") i czcionki BARcode.
Testowałem u siebie i działa OK. Kod jest czytany przez czytnik.

Makro reaguje też na zmiany wartości.
Czy polecenia w komórkach i odwołania do nich są właściwe?
Sprawdź czy komórki wyświetlają poprawnie same wartości o które Ci chodzi,
i jeśli tak to obejmij je makrem CODE128 i nawiasem oraz zmień czcionkę na BARcode .

P.S:
Polecenie Excela które wyciągnie pogrubione znaki: =FRAGMENT.TEKSTU("%00333000260238510724B113616";9;14)
Polecenie generujące kod: =code128(FRAGMENT.TEKSTU("%00333000260238510724B113616";9;14))
W miejsce ciągu znaków można wstawić adres komórki zawierającej ciąg znaków: =code128(FRAGMENT.TEKSTU(D12;9;14))
W tym przykładzie D12 .
Polecenie FRAGMENT.TEKSTU() w rzeczywistości nie wyszukuje stylu formatowania znaków,
ale zawiera ich lokalizację w ciągu, tu pierwszy argument to ciąg znaków, drugi początkowy znak w ciągu i trzeci długość oczekiwanego ciągu.
Pozdrawiam.

W razie problemów służę pomocą.
MrTN. OOo 3.3 , Win7 .
martaposty1
Posty: 12
Rejestracja: wt lip 02, 2013 2:20 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: martaposty1 »

Generator kodów kreskowych pozwala na zakodowanie wszystkich 128 znaków ASCII, od 0 do 127 włącznie. Kod 128 jest jedną z symbolik kodów kreskowych powszechnie stosowanych dzięki swoim parametrom i braku wymagań rejestracyjnych. Kod 128 cechuje się dużym zagęszczeniem informacji, zwłaszcza numerycznych.

Udostępniony tutaj generator kodów kreskowych dla OpenOffice Calc dobrze generuje właśnie kod 128.
Spójrz praw­dzie w oczy i po­wiedz, że to kłamstwo...
przechera
Posty: 1
Rejestracja: czw lip 07, 2016 12:04 pm

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: przechera »

srodek_86 pisze:Udało się:) Mam czcionke już dostosowaną do wymogów poczty. Bardzo mi się przydały twoje dane. Podniosłem ją do 100 px i jest ok. W poniedziałek sprawdzę na poczcie na skanerze jak działają kody, ale jestem pewien że będzie dobrze, bo idealnie sie pokrywają. Dzięki za wszystko bardzo ułatwiłeś mi życie. A mam pytanie orientujesz się może jak działa makro na wysyłanie poczty z calc?
Również tworzę etykietę logistyczną GS1 i wyższą czcionkę porzebowałem, w fontstruct.com udostępniam pod nazwą BarkodeZJA
Libre Office 5.1.2.2 (x64) na Windows 10
laiten
Posty: 1
Rejestracja: pn paź 10, 2016 9:50 am
Kontakt:

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: laiten »

Witam, czy testował ktoś na wersji 4.1.2 ?
U mnie niestety jest problem. Używam czcionki Code 128. Barcod jest, ale po zmianie symboli z kodem nic się nie dzieje.
OpenOffice 4.1.2 na Windows 10. Pakiet biuro wy wykorzystuje prowadząc własne biuro rachunkowe. Jelenia Góra - to tutaj mieszkam i prowadzę swoja działalność
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

laiten pisze:Witam, czy testował ktoś na wersji 4.1.2 ?
U mnie niestety jest problem. Używam czcionki Code 128. Barcod jest, ale po zmianie symboli z kodem nic się nie dzieje.
Witam.
Aktualnie używam tej wersji na Win10 i działa ok.
W Excelu też działa. Podaj więcej szczegółów.
Co wpisujesz w komórkę, co się wyświetla a co powinno się wyświetlać ?
Postaram się pomóż.
MrTN. OOo 3.3 , Win7 .
intonelad
Posty: 1
Rejestracja: pt paź 14, 2016 3:05 pm
Kontakt:

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: intonelad »

Skorzystałem wczoraj ze skryptów, wszystko działa jak należy, dziękuję :)
Pakietu OO używam w sowim biurze rachunkowym, gdzie pracuję jako księgowa Jelenia Góra - to tutaj pracuję. Warto zarzeć również na umowa kupna sprzedaży samochodu
yalyonc
Posty: 1
Rejestracja: śr lis 02, 2016 10:13 am
Kontakt:

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: yalyonc »

Jeśli przy Code 128 otrzymuje taki błąd:

ByRef argument type mismatch.
----------------
If check4(data) > 3 Then
-------------------

To co powinnam zrobić?
do kiedy PIT 37 OpenOffice 4.1.2, Windows 10. OpenOffice pomaga mi w pracach biurowych, a takze przy wypelnianiu dokumentow itp. Praca jako księgowa Jelenia Góra bardzo mnie satysfakcjonuje.
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

yalyonc pisze:Jeśli przy Code 128 otrzymuje taki błąd:

ByRef argument type mismatch.
----------------
If check4(data) > 3 Then
-------------------

To co powinnam zrobić?

A jak wygląda argument?
co wpisujesz w poleceniu?

Wygląda to na niewłaściwy argument.
Czyli wprowadzasz do makra dane z których nie można utworzyć kodu.
Sprawdź czy nie ma gdzieś literówki.

I podaj jaki używasz pakiet biurowy i w jakiej wersji.
MrTN. OOo 3.3 , Win7 .
rares
Posty: 1
Rejestracja: pn lis 28, 2016 11:13 am
Kontakt:

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: rares »

Witam, skorzystałam z Pańskiego generatora (znalazłąm go szukając czegoś podobnie działającego w googlach) i działa super! Dlatego warto podziękować, bo uratował mi skórę :D Dziękuję :)
OpenOffice 4.1.2, Windows 8.1. Pracuje jako ksiegowa Walbrzychska i OpenOffica uzywam na co dzien w pracy. Księgowa Kalisz
Simon123
Posty: 3
Rejestracja: czw wrz 06, 2018 11:21 am

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: Simon123 »

Hej,
Prośba o podpowiedź co należy zrobić, aby rozwiązanie dla GS1-128 działało w excelu. Skopiowałem kod dla GS1 oraz zainstalowałem fonts i wyświetlają się tylko znaki specjalne (nie paski). Czy Barcode font działa również w excelu?

Pozdrawiam.

Simon
OpenOffice 3.1 na Windows Vista
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Re: Code128 generator, calc, barcode, macro, GS1, GPL .

Post autor: OOoUser46 »

Simon123 pisze:Hej,
Prośba o podpowiedź co należy zrobić, aby rozwiązanie dla GS1-128 działało w excelu. Skopiowałem kod dla GS1 oraz zainstalowałem fonts i wyświetlają się tylko znaki specjalne (nie paski). Czy Barcode font działa również w excelu?

Pozdrawiam.

Simon
Sprawdź to.
Pozdrawiam.

Kod: Zaznacz cały



Rem  *****  BASIC  *****
Rem V2.3 07-09-2018
Rem Barcode creator GS1-128 by TN
Rem This function generates a code GS1-128 (EAN128) with a set of characters B and C.
Rem Switchable between a set of B and C is automatic.
Rem
Rem GNU GPL General Public Licence
Rem Free to commercial and private use.
Rem
Rem Running the command:
Rem GS1_128(IZ1 ; Data1 ; IZ2 ; Data2 ; IZ3 ; Data3 ; IZ4 ; Data4)
Rem GS1 specification provides the ability to use all ASCII characters.
Rem
Rem ! NOTE !
Rem For proper operation requires the correct font barcode.ttf
Rem http://user.services.openoffice.org/pl/forum/download/file.php?id=429
Rem -----------------------------------------------------------------------------------

Function GS1_128$(Optional iz1%, Optional data1$, Optional iz2%, Optional data2$, Optional iz3%, Optional data3$, Optional iz4%, Optional data4$)
   
   GS1_128 = "" ' inicjowanie zmiennej
   
   Dim iz_size%, fnc1%, pos%, mode%, data_tab%(1 To 48)
   
   fnc1 = 0
   pos = 1
   
   If Not IsMissing(iz1) And Not IsMissing(data1) And data1 <> "" And data1 <> "0" Then
      If iz1 < 0 Or iz1 > 9999 Then GoTo errend
      If Len(data1) > 80 Then GoTo errend
      If iz_set(iz1, iz_size) Then GoTo errend
      If data_set(iz1, data1, iz_size, pos, mode, data_tab) Then GoTo errend
      If iz_size = 0 Then fnc = 1
   End If
   
   If Not IsMissing(iz2) And Not IsMissing(data2) And data2 <> "" And data1 <> "0" Then
      If iz2 < 0 Or iz2 > 9999 Then GoTo errend
      If Len(data2) > 80 Then GoTo errend
      If fnc = 1 Then
         data_tab(pos) = 102
         pos = pos + 1
         fnc = 0
      End If
      If iz_set(iz2, iz_size) Then GoTo errend
      If data_set(iz2, data2, iz_size, pos, mode, data_tab) Then GoTo errend
      If iz_size = 0 Then fnc = 1
   End If
   
   If Not IsMissing(iz3) And Not IsMissing(data3) And data3 <> "" And data1 <> "0" Then
      If iz3 < 0 Or iz3 > 9999 Then GoTo errend
      If Len(data3) > 80 Then GoTo errend
      If fnc = 1 Then
         data_tab(pos) = 102
         pos = pos + 1
         fnc = 0
      End If
      If iz_set(iz3, iz_size) Then GoTo errend
      If data_set(iz3, data3, iz_size, pos, mode, data_tab) Then GoTo errend
      If iz_size = 0 Then fnc = 1
   End If
   
   If Not IsMissing(iz4) And Not IsMissing(data4) And data4 <> "" And data1 <> "0" Then
      If iz4 < 0 Or iz4 > 9999 Then GoTo errend
      If Len(data4) > 80 Then GoTo errend
      If fnc = 1 Then
         data_tab(pos) = 102
         pos = pos + 1
         fnc = 0
      End If
      If iz_set(iz4, iz_size) Then GoTo errend
      If data_set(iz4, data4, iz_size, pos, mode, data_tab) Then GoTo errend
      If iz_size = 0 Then fnc = 1
   End If
   
   If pos > 1 Then
      pos = pos - 1
   Else
      GoTo endend:
   End If
   
   Dim bar_tab$()
   bartab = Array( _
    "BEBFBF", "BFBEBF", "BFBFBE", "AFAFBG", "AFAGBF", "AGAFBF", "AFBFAG", "AFBGAF", "AGBFAF", "BFAFAG", _
    "BFAGAF", "BGAFAF", "AEBFCF", "AFBECF", "AFBFCE", "AECFBF", "AFCEBF", "AFCFBE", "BFCFAE", "BFAECF", _
    "BFAFCE", "BECFAF", "BFCEAF", "CEBECE", "CEAFBF", "CFAEBF", "CFAFBE", "CEBFAF", "CFBEAF", "CFBFAE", _
    "BEBEBG", "BEBGBE", "BGBEBE", "AEAGBG", "AGAEBG", "AGAGBE", "AEBGAG", "AGBEAG", "AGBGAE", "BEAGAG", _
    "BGAEAG", "BGAGAE", "AEBECG", "AEBGCE", "AGBECE", "AECEBG", "AECGBE", "AGCEBE", "CECEBE", "BEAGCE", _
    "BGAECE", "BECEAG", "BECGAE", "BECECE", "CEAEBG", "CEAGBE", "CGAEBE", "CEBEAG", "CEBGAE", "CGBEAE", _
    "CEDEAE", "BFAHAE", "DGAEAE", "AEAFBH", "AEAHBF", "AFAEBH", "AFAHBE", "AHAEBF", "AHAFBE", "AEBFAH", _
    "AEBHAF", "AFBEAH", "AFBHAE", "AHBEAF", "AHBFAE", "BHAFAE", "BFAEAH", "DECEAE", "BHAEAF", "AGDEAE", _
    "AEAFDF", "AFAEDF", "AFAFDE", "AEDFAF", "AFDEAF", "AFDFAE", "DEAFAF", "DFAEAF", "DFAFAE", "BEBEDE", _
    "BEDEBE", "DEBEBE", "AEAEDG", "AEAGDE", "AGAEDE", "AEDEAG", "AEDGAE", "DEAEAG", "DEAGAE", "AECEDE", _
    "AEDECE", "CEAEDE", "DEAECE", "HBEAHAF", "HBEAFAH", "HBEAFCF", "BGCEAEBH")
    '100      101      FNC1      START A  STERT B   START C   STOP
    
   For fnc1 = 1 To pos
      GS1_128 = GS1_128 & bartab(data_tab(fnc1))
   Next fnc1
   
   Dim check&
   check = data_tab(1)
   For fnc1 = 2 To pos
      check = check + data_tab(fnc1) * (fnc1 - 1)
   Next fnc1
   check = check Mod 103
   
   GS1_128 = GS1_128 & bartab(check) & bartab(106)   ' STOP
   
   GoTo endend:
errend:
   GS1_128 = "err"
endend:
End Function

Function iz_set%(iz%, iz_size%) ' wyliczenie dlugosci dla znanych identyfikatorow
   iz_set = 0 'brak bledu
   iz_size = 0 'domyslnie dlugosc automatyczna
   
   'znane stale identyfikatory
   If iz = 0 Then iz_size = 18 ' Seryjny Numer Jednostki Wysyłkowej (SSCC)
   If iz = 1 Then iz_size = 14 ' Globalny Numer Jednostki Handlowej (GTIN)
   If iz = 2 Then iz_size = 14 ' Numer GTIN towarów zawartych w innej jednostce
   If iz = 11 Then iz_size = 6 ' Data produkcji (RRMMDD)
   If iz = 12 Then iz_size = 6 ' Data płatności (RRMMDD)
   If iz = 13 Then iz_size = 6 ' Data pakowania (RRMMDD)
   If iz = 15 Then iz_size = 6 ' Minimalna data trwałości (RRMMDD)
   If iz = 16 Then iz_size = 6 ' Maksymalna data sprzedaży (RRMMDD)
   If iz = 17 Then iz_size = 6 ' Maksymalna data trwałości (RRMMDD)
   If iz = 20 Then iz_size = 2 ' Wariant produktu
   
   ' Logistyka, objętość, Masa, Powierzchnia, wymiary, Długość
   If iz >= 3100 And iz <= 3199 Then iz_size = 6
   If iz >= 3200 And iz <= 3379 Then iz_size = 6
   If iz >= 3400 And iz <= 3579 Then iz_size = 6
   If iz >= 3600 And iz <= 3699 Then iz_size = 6
   
   If iz = 410 Then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - wysłać do
   If iz = 411 Then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - faktura dla
   If iz = 412 Then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - zakupiono od
   If iz = 413 Then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - wysłać dla
   If iz = 414 Then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - identyfikacja lokalizacji fizycznej
   If iz = 415 Then iz_size = 13 ' Globalny Numer Lokalizacyjny GS1 - wystawca faktury
   If iz = 424 Then iz_size = 3 ' Kraj przetworzenia
   If iz = 425 Then iz_size = 3 ' Kraj demontażu
   If iz = 426 Then iz_size = 3 ' Kraj obejmujący cały łańcuch przetwórczy
   If iz = 7001 Then iz_size = 13 ' Numer zapasów NATO (NSN)
   If iz = 7003 Then iz_size = 10 ' Data i czas ważności (RRMMDDhhmm)
   If iz = 7006 Then iz_size = 6 ' Data pierwszego zamrożenia (RRMMDD)
   If iz = 8001 Then iz_size = 14 ' Produkty w rolkach – szerokość, długość, średnica rdzenia, kierunek i zwoje
   If iz = 8005 Then iz_size = 6 ' Cena za jednostkę miary
   If iz = 8006 Then iz_size = 18 ' Identyfikacja elementów jednostki handlowej GCTIN
   If iz = 8017 Then iz_size = 18 ' Globalny Numer Relacji Usługowych (GSRN) - świadczeniodawca
   If iz = 8018 Then iz_size = 18 ' Globalny Numer Relacji Usługowych (GSRN) - świadczeniobiorca
   If iz = 8100 Then iz_size = 6 ' Rozszerzony kod kupony GS1-128
   If iz = 8101 Then iz_size = 10 ' Rozszerzony kod kupony GS1-128
   If iz = 8102 Then iz_size = 2 ' Rozszerzony kody GS1-128
   
   
End Function

Function data_set%(iz%, data$, iz_size%, pos%, mode%, data_tab)
   
   data_set = 1 ' flaga bledu
   Dim c%, p%, si%, sd%, sa%
   
   si = Len(CStr(iz)) ' size of IZ
   sd = Len(data) ' size of data
   
   If iz_size = 0 Then ' size auto
      If si = 1 Then ' iz min 2
         sa = si + sd + 1
      Else ' dlugosc IZ+DATA
         sa = si + sd
      End If
   Else ' size const
      If si = 1 Then ' iz min 2
         sa = si + iz_size + 1 ' IZ 0n
      Else ' dlugosc IZ+DATA
         sa = si + iz_size ' si + const size
      End If
   End If
   
   Dim tmp_tab%(1 To 100)
   
   ' print IZ
   
   If si = 1 Then ' size IZ=1
      tmp_tab(1) = 48 ' 0
      tmp_tab(2) = Asc(iz) ' (0-9)
      p = 3 ' position
   Else
      For c = 1 To si
         tmp_tab(c) = Asc(Mid(iz, c, 1))
      Next c
      p = si + 1 ' position
   End If
   
   ' print data
   If iz_size = 0 Or sd <= iz_size Then ' check data
   
     'if si+sd<iz_size then ' zera wiodace
      If sd < iz_size Then ' dodaj zera wiodace
         For c = sd + 1 To iz_size
            tmp_tab(p) = 48 ' '0'
            p = p + 1 ' position
         Next c
      End If
      
      For c = 1 To sd ' print data
         tmp_tab(p) = Asc(Mid(data, c, 1))
         If tmp_tab(p) < 32 Then GoTo end_data_set:
         If tmp_tab(p) > 126 Then GoTo end_data_set:
         p = p + 1
      Next c
      
   Else
      GoTo end_data_set: ' end,err
   End If
   
   For c = 1 To sa
      
      If mode = 0 Then
         p = 0
         For si = c To sa
            If tmp_tab(si) > 47 And tmp_tab(si) < 58 Then p = p + 1
            If tmp_tab(si) < 48 Or tmp_tab(si) > 57 Then Exit For
         Next si
         If p > 3 Then
            data_tab(1) = 105   ' START C
            mode = 3
         Else
            data_tab(1) = 104   ' START B
            mode = 2
         End If
         data_tab(2) = 102   ' FNC1
         pos = 3
      End If
      
      
      p = 0
      For si = c To sa
         If tmp_tab(si) > 47 And tmp_tab(si) < 58 Then p = p + 1
         If tmp_tab(si) < 48 Or tmp_tab(si) > 57 Then Exit For
      Next si
      
      If mode = 2 And p > 3 Then
         data_tab(pos) = 99   ' CODE C
         pos = pos + 1
         If pos > 48 Then GoTo end_data_set:
         mode = 3
      End If
      
      If mode = 3 And p > 1 Then
         data_tab(pos) = (tmp_tab(c) - 48) * 10 + (tmp_tab(c + 1) - 48)
         pos = pos + 1
         c = c + 1
         If pos > 48 Then GoTo end_data_set:
      End If
      
      If mode = 3 And p < 2 Then
         data_tab(pos) = 100   ' CODE B
         pos = pos + 1
         If pos > 48 Then GoTo end_data_set:
         mode = 2
      End If
      
      If mode = 2 And p < 4 Then
         data_tab(pos) = tmp_tab(c) - 32
         pos = pos + 1
         If pos > 48 Then GoTo end_data_set:
      End If
   Next c

   data_set = 0 ' brak bledu
end_data_set:    ' koniec
End Function


MrTN. OOo 3.3 , Win7 .
ODPOWIEDZ