الباركود

[محمدعوض]

سلام اريد المساعدت في  عمل هذا المقصود في اكسيل هل من الممكن تحقيق هذا ...

اريد عند الكتابت الباركود يظهر  المعلومات بس يتم تعريف الباركودات لصنف واحد ياخد اكتر من الباركود ولكن يحمل نفس اسم الصنف يعني من الممكن يكون الباركود 1 و2 و3 و4 و5 يحمل نفس الاسم الصنف كيفية تحقيق  مثل هذا وشكرا ...

يوجد توضيح اكثر في الاكسل وشكرا ....

 

barcode.zip

[محمدعوض]

ياخوان هل يوجد معادلة لعمل المطلوب وشكرا

[ابو علي و سدرة]

جرب المرفق هلى به ما يناسب احتياجك او لا

 

barcode.rar

[خزاني]

الباركود

Module-EAN13

Option Explicit
Const KDigits = "0123456789"
Const KTbA = "ABCDEFGHIJ", KTbB = "KLMNOPQRST", KTbC = "abcdefghij"
Const KTbD = "0123456789", KtbE = "klmnopqrst"
Const KCode = "AAAAAAAABABBAABBABAABBBAABAABBABBAABABBBAAABABABABABBAABBABA"
Public Const KEAN13 = "EAN13.TTF"
Function EAN13$(ByVal Chaine$)
Dim Bcle%, Codage$, Check&, Car$
  Chaine = Left$(Chaine, 12)
  If Len(Chaine) < 12 Then Exit Function
  For Bcle = 1 To 12
    Car = Mid$(Chaine, Bcle, 1)
    If Car < "0" Or Car > "9" Then Exit Function
    Check = Check + Car * (2 * ((Bcle - 1) Mod 2) + 1)
  Next Bcle
  Chaine = Chaine & 10 - (Check Mod 10) Mod 10

  EAN13 = Left$(Chaine, 1) & Space$(6) & "*" & Space(6) & "+"
  Codage = Mid$(KCode, Left$(Chaine, 1) * 6 + 1, 6)

  For Bcle = 2 To 7
    If Mid$(Codage, Bcle - 1, 1) = "A" Then
      Mid$(EAN13, Bcle, 1) = Mid$(KTbA, Mid$(Chaine, Bcle, 1) + 1, 1)
    Else
      Mid$(EAN13, Bcle, 1) = Mid$(KTbB, Mid$(Chaine, Bcle, 1) + 1, 1)
    End If
  Next Bcle

  For Bcle = 8 To 13
    Mid$(EAN13, Bcle + 1, 1) = Mid$(KTbC, Mid$(Chaine, Bcle, 1) + 1, 1)
  Next Bcle
End Function
Function EAN8$(ByVal Chaine$)
Dim Bcle%, Car$, Check%
  Chaine = Left$(Chaine, 7)
  If Len(Chaine) < 7 Then Exit Function
  For Bcle = 1 To 7
    Car = Mid$(Chaine, Bcle, 1)
    If Car < "0" Or Car > "9" Then Exit Function
    Check = Check + Car * (2 * (Bcle Mod 2) + 1)
  Next Bcle
  Chaine = Chaine & 10 - (Check Mod 10) Mod 10

  EAN8 = ":" & Space$(4) & "*" & Space(4) & "+"
  For Bcle = 1 To 4
    Mid$(EAN8, Bcle + 1, 1) = Mid$(KTbA, Mid$(Chaine, Bcle, 1) + 1, 1)
  Next Bcle
  For Bcle = 5 To 8
    Mid$(EAN8, Bcle + 2, 1) = Mid$(KTbC, Mid$(Chaine, Bcle, 1) + 1, 1)
  Next Bcle
End Function

[محمدعوض]

كيفية استعمال الكود اخي

[خزاني]

khezzani-barrcode.rar

[ياسر خليل أبو البراء]

أخي الحبيب خزاني ..

جزيت خيراً أخي الغالي وبارك الله فيك

تعطيني الدالة المعرفة خطأ ..يرجى إرفاق ملف لمعرفة سبب المشكلة

تقبل تحياتي

[خزاني]

أخي الحبيب خزاني ..

جزيت خيراً أخي الغالي وبارك الله فيك

تعطيني الدالة المعرفة خطأ ..يرجى إرفاق ملف لمعرفة سبب المشكلة

تقبل تحياتي

مثال تطبيقي:

codebarre.rar

[ياسر خليل أبو البراء]

جزاك الله خير الجزاء أخي الحبيب خزاني

ولكن هل لي أن أسأل ما هي الاستفادة العملية التطبيقية من الباركود؟

لأني لاحظت أن الكثير في الفترة الأخيرة يسأل عن هذا الأمر ، وصراحة لا أعلم الفائدة العملية من وراء ذلك الأمر؟

تقبل ودي واحترامي وتحياتي

[محمد الورفلي1]

السلام عليكم

استاذ خزاني شكراً

كود جميل واعتقد ان الباركود يقص ويلصق على اكياس المواد الغذائية ويوجد جهاز خاص يقرأ هذه الخطوط ................. والله اعلم

[الزباري]

تابعوا موضوع الباركود على

 

http://www.officena.net/ib/index.php?showtopic=61143&hl=