Új hozzászólás Aktív témák

• #2520 vilag tag sztanozs #2519

  Új Válasz 2014-10-08 10:59:54 #2520

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  vilag

  tag

  válasz sztanozs #2519 üzenetére

  A kollégám hozzájárulásával közzéteszem.

  Röviden annyi a lényeg, hogy maga a vonalkód betűtípus nem elégséges arra, hogy visszaolvasható vonalkódot készítsünk, kell még bele egy indító- egy záró- és egy ellenőrző karakter is.

  Az alábbi kódrészlet a magyar postai ragszámnak- (RL) és a nemzetközi ragszámnak (RR) megfelelő vonalkódot generál.
  Figyelem! Az alábbi kóddal generált ragszám "képe" nem egyezik meg (hosszabb) a ragszámon lévő vonalkód képével, azonban beolvasáskor ugyan azt az értéket kapjuk!

  Public szov As String
  Public h As Long
  
  Private Sub CommandButton1_Click()
  
  vkod = ""
  ossz = 0
  szov = Trim(InputBox("Vonalkód értéke:", "Kód bevitel"))
  ActiveSheet.Cells(3, 3) = szov
  If szov = "" Then GoTo vege
  h = Len(szov)
  If h > 100 Then GoTo vege
  
  Dim vk(2, 100)
  For i = 0 To h
  If i = 0 Then
  vk(1, i) = Chr(204)
  vk(2, i) = 104
  Else
  vk(1, i) = Mid(szov, i, 1)
  vk(2, i) = Asc(vk(1, i)) - 32
  End If
  If i = 0 Then k = 1 Else k = i
  ossz = ossz + vk(2, i) * k
  vkod = vkod + vk(1, i)
  Next
  
  eossz = ossz Mod 103
  ActiveSheet.Cells(2, 2) = eossz
  vkod = vkod + Chr(eossz + 32) + Chr(206)
  ActiveSheet.Cells(2, 3) = vkod
  vege:
  vege = MsgBox("Konverzió vége!", vbOKOnly, "Vége")
  
  End Sub

  Az eltérésnek az az oka, hogy a vonalkódban rövidítést alkalmazni, azaz minden számpár helyére az értékének megfelelő karakter kerül. Pl.: a RL33... -nál a 33 helyére az "A" betű kódja kerül.

  Az alábbi kóddal generált vonalkód képe megegyezik a valódi ragszámon megjelenő "képpel" azonban ez csak a magyar (RL) ragszámmal működik!
  A nemzetközi ragszámhoz (RR) még ki kell derítenünk az algoritmust, aztán remélhetőleg azt is megcsináljuk.

  Public szov As String
  Public h As Long
  
  Private Sub CommandButton1_Click()
  
  vkod = ""
  ossz = 0
  szov = Trim(InputBox("Vonalkód értéke:", "Kód bevitel"))
  ActiveSheet.Cells(3, 3) = szov
  If szov = "" Then GoTo vege
  h = Len(szov)
  If h > 100 Then GoTo vege
  j = 1
  
  
  Dim vk(2, 100)
  
  For i = 0 To h
  
  Select Case i
  Case 0
  vk(1, i) = Chr(204)
  vk(2, i) = 104
  j = i
  Case 1 To 2
  vk(1, i) = Mid(szov, i, 1)
  If Asc(vk(1, i)) < 195 Then vk(2, i) = Asc(vk(1, i)) - 32 Else vk(2, i) = Asc(vk(1, i)) - 100
  j = i
  Case 3
  j = i
  vk(1, i) = Chr(199)
  vk(2, i) = Asc(vk(1, i)) - 100
  Case Else
  If Application.WorksheetFunction.IsEven(i) = True Then
  j = i - ((i - 4) / 2)
  s2 = Val(Mid(szov, i - 1, 2))
  If s2 < 95 Then vk(1, j) = Chr(s2 + 32) Else vk(1, j) = Chr(s2 + 100)
  vk(2, j) = s2
  End If
  
  
  
  End Select
  If j = 0 Then k = 1 Else k = j
  If i <= 3 Or Application.WorksheetFunction.IsEven(i) = True Then
  ossz = ossz + vk(2, j) * k
  vkod = vkod + vk(1, j)
  End If
  Next
  
  eossz = ossz Mod 103
  ActiveSheet.Cells(2, 2) = eossz
  vkod = vkod + Chr(eossz + 32) + Chr(206)
  ActiveSheet.Cells(2, 3) = vkod
  vege:
  vege = MsgBox("Konverzió vége!", vbOKOnly, "Vége")
  
  End Sub

  Szerk.: Ahhoz, hogy valóban vonalkódot állítsunk elő a fentiek segítségével, ahhoz szükség van még egy Code 128 B betűtípusra is, melyet a googli segítségével könnyedén találhatunk.

  Ha azt szeretnénk, hogy a kapott vonalkód más -olyan számítógépeken is megjelenjen, amelyeken az adott betűtípus nincs telepítve, akkor a betűtípust be kell ágyaznunk a fájlba, hogy vigye magával.
  Ez csak ttf és otf betűtípusok esetében lehetséges és csak akkor, ha a betűtípus licence megengedi.

  Beágyazás: Office 2007 Word esetében: Fájl/Word beállításai/Mentés/Betűtípusok beágyazása fájlba.

Új hozzászólás Aktív témák