• 0
zahrah

كل شيئ عن الباركود في الاكسيس

سؤال

اعزائي الكرام

السلام عليكم ورحمة الله وبركاته

كثرت الاسئلة عن استخدام الباركود مع برنامج الاكسيس لهذا نضع بين ايديكم الحل الامثل والطريقة تتمثل في التالي

اولا : ما هو الباركود " لم اجد تعبيرا افضل من تعبير استاذنا طارق حنيدق حيث قال "

هى وسيلة بسيطة لتعريف الارقام يسهل معها استعادة الرقم بجهاز قارئ للباركود ومنذ اختراعه له استخدامات عديدة المخازن الكارنيهات والبطاقات وايضا فى السوبرماركت حيث انه يوفر الوقت باستخدام جهاز القارئ ومنه يعطى اسم الصنف وسعرة واى بيانات اخرى وما على المستخدم الكاشير الا ان يدخل الكمية فقط وبالتالى يكون استخدام الموضوع له اهمية

واهميته فى الاكسس اننا كمبرمجين اكسس لانحب ان نلجأ الى حلول برمجية من خارج الاكسس لحبنا الاكسس هذا اولا ثم اعتقاد منى والله اعلم اننا لسنا فى حاجة الى حلول من خارج الاكسس والا نبحث عن لغة برمجة اخرى وان كنت من واقع خبرتى لايوجد مايضاهى الاكسس من حيث سهولة الاستخدام وواقعية التنفيذ وخاصة مع دخول ADO و SQL2000

( مع احترامى الشديد لمبرمجى اوراكل ودلفى ) انتهى كلامه ..

المعدات اللازمه لذلك

1. قارئة باركود

IDAutomation_USB_Barcode_Scanner.jpg

2. طابعة باركود لطباعة الملصقات بعد اخراجها من التقرير

Thermal_Bar_Code_Label_Printer.jpg

3. ورق وملصقات

Barcode_Label_Software.jpg

4.خطوط خاصة بالباركود مثل خط Code39 وخط Code128

لتحميل الخطوط

ALLBarcode Font.rar

IDAutomationCode39.zip

5. برنامج اكسيس مع الاداة الخاصة بالباركود

طريقة تسجيل الاداة barcodex.ocx في الويندوز ليقبلها الاكسيس

1. بعد تحميل الاداة من الملف المرفق قم بنسخ الاداة الى مجلد C:\WINDOWS\system32

2. اذهب الى ابدأ واختر تشغيل وضع هذا الامر في المربع الحواري الظاهر امامك

regsvr32 "C:\WINDOWS\system32\barcodex.ocx"

3. اضغط موافق وسيتم تسجيل الاداة وظهور رسالة تفيد بإتمام عملية التسجيل بنجاح

4. الان افتح ملف الاكسيس المرفق وانظر النتيجه

barcodex.rar

ملاحظة : تستطيع كتابة الارقام والحروف مثل 100-25-10001 او zahrah او arabteam2000 او 123456789 ثم الضغط على انتر Enter في لوحة المفاتيح وستجد البرنامج يقوم بإظهار رمز الباركود المقابل له في النموذج

اختكم

زهره

تم تعديل بواسطه zahrah
3

شارك هذا الرد


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

65 إجابة على هذا السؤال .

  • 0

 

فانا اريد كود يمنع كتابه اي شيء عن طريق لوحة المفاتيح ويسمح فقط باستخدام القارئ

الأخ / yms12

هناك فكرة برمجية وهي أن تترك المستخدم يكتب ما يشاء ثم تحذف ما كتب

 

 

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

الأخ / Khodor1985

جرب المرفق على نظام 64 بت

للأسف ليس عندي لكي أجرب

 

اصدار Barcodex.oca هو 5.5

 

هناك مشكلة في رفع المرفقات

حمل من هذا الرابط

https://www.mediafire.com/?vful88y358zm8t7

تم تعديل بواسطه amir2008amir
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

شكرا جزاكم الله خير الملف 64 ظبط معي

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

السلام عليكم ورحمة الله

من فضلكم عند تثبيت اداة barcodex فى الويندوز تظهر هذه الرسالة فما السبب ؟

Untitled.jpg

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

السلام عليكم و رحمة الله وبركاته

جزاكم الله خير ايا أخت زهرة على هذا الموضوع المهم

و لكن لي سؤال : كيف يمكننا استخدام الماسح الضوئي في ادخال الرقم إلى قاعدة البيانات

و هل هناك أوامر معينة لذلك ....

و هل الأمر محتاج معالجة معينة ..

و جزاكم الله خير ا

أخوكم : ابو رحمة

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

اخي الكريم ابو رحمه

و لكن لي سؤال : كيف يمكننا استخدام الماسح الضوئي في ادخال الرقم إلى قاعدة البيانات

و هل هناك أوامر معينة لذلك ....

و هل الأمر محتاج معالجة معينة ..

كما تعلم اخي الكريم ان جهاز الماسح الخاص بالباركود يأتي معه من ضمن الادوات الخاصه به برامج واسلاك توصيل وكتيبات فالبرامج مثلا يمكن تنزيلها على النظام سواء كان ويندوز او ماكنتوش او دوس او غيرها من الانظمه ويتم تعريف المخارج سواء كانت USB او COM بواسطة البرامج المرفقه كما يمكن استخدامه مع الكاشير الموجوده في الصيدليات او السوبرماركت الكبيره .

لهذا نقوم ببناء برنامج او قاعدة بيانات على تطبيق الاكسيس او غيره من البرامج يحتوي على ارقام الاصناف الموجوده بالمحل ومن تشغيل القاعده وبمجرد استخدام الماسح " جهاز الباركود " على اي ملصق يحتوي على ارقام باركود فإنه يتم تخزينها في قاعدة البيانات وذلك لسرعة الادخال بدلا من الطريقة اليدوية

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

أختي الكريمة و معلمتي : الأستاذة زهرة

حضرتك ذكرت التالي :

"لهذا نقوم ببناء برنامج او قاعدة بيانات على تطبيق الاكسيس او غيره من البرامج يحتوي على ارقام

الاصناف الموجوده بالمحل

حتى الأن مفهوم حيث يوجد جدول به الأصناف مرقمة و مكودة و نستخدم علاقة (one to many )

و بمجرد إدخال الرقم يتم سرد تفاصيل المنتج

ومن تشغيل القاعده وبمجرد استخدام الماسح " جهاز الباركود " على اي

ملصق يحتوي على ارقام باركود فإنه يتم تخزينها في قاعدة البيانات وذلك لسرعة الادخال بدلا من

الطريقة اليدوية"

كيف نوظف في الأكسيس الباركود كجهاز إدخال

حسب معلوماتي الباركود مثل الكي بورد

و جزاكم الله خيرا على سعة صدركم و شرحكم

ة يا ريت يتم إرفاق مثال عملي

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

الأخت الفاضلة زهرة

سأستغل وجود حضرتك معنا في هذا الموضوع و أدعو حضرتك

لزيارة موضوعي عن

: مصابيح البرمجة

و كل عام و أنتم بخير

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

اخي ابو وليد

تم تعديل الخط 128 تستطيع التحميل الان

ملاحظة بعد تحميل مرفقات الخطوط قم بفك الضغط عنها ومن ثم قم بنسخ الخطوط وضعها في مجلد C:\Windows\Fonts

الاخ

كيف نوظف في الأكسيس الباركود كجهاز إدخال

حسب معلوماتي الباركود مثل الكي بورد

كما تعلم ان جهاز الباركود يأتي معه برامج ملحقه ويتم تعريفه من خلال الويندوز كجهاز ادخال شأنه شأن لوحة المفاتيح كما يوجد به زر جانبي عند الضغط عليه يكون جهاز الباركود هو النشط ويتم استخدامه لقراءة الكود الموجود على الملصقات .

اذا رغبت ببرامج جاهزه تستخدم الباركود ولوحة المفاتيح في عمليات الادخال فإليك التالي :

برنامج المخزن تجده هنا كاملا مع الشرح

برنامج المخزن

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

http://www.minaret.cc/EBar.exe

تحديث البرنامج بتاريخ 24/3/2004

التحديث يحتوي على التحكم بطباعة الهوامش

http://www.minaret.cc/EBarU.zip

اختكم

زهره

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

طيب أنا عندي برنامج شئون موظفين

حبيت أعمل بطائق علشان يحضر بها الشخص بدل حافظة الدوام والتوقيع

كيف استخدم الباراكود وهل هناك بطائق جاهزة عليها شفرات الباركود

ايضا أريد ان يتوقف عمل الباراكود بعد الساعة الثامنة والنصف صباحا ولايصبح نشط الا بعد الساعة الثانية عشرة والنصف وقت الانصراف ؟؟؟

هل ممكن ذلك

وشكرا اخت زهرة ولانستطيع ان نجازيك الا بدعوات وقت الفجر وشكرا مرة ثانية

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

الأخت الكريمة زهرة

جزاكم الله خيرا على ردكم

أنا فهمت من خلال كلام حضرتك أن عمل الباركود سكنر ينحصر في

إدخال الرقم المعرف + ( 13)chr

و الباقي على المبرمج (......يعنى الباقي سهل .....)

أليس كذلك

من فضلك أعلمينا بالصواب

وجزاكم الله خيرا

ابو رحمة

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

كنت اتمنى ان يشاركنا استاذنا ابو هادي لخبرته الطويله في هذا المجال ولكن سنضع مشاركه له من منتدى اوفيسنا

http://www.officena.com/ib/index.php?showtopic=745

اقتباس : نقلا عن ابو هادي

قد صممت برنامجا للحضور انطلاقا من هذا المثال وهو الآن من البرامج الأساسية بالشركة وقد كفانا عذاب الإدخال الشهري وأخطاء الإدخال وشكاوي الموظفين ممن لا يريحهم نتائج خارج الدوام "OV" .

من الأفكار التي طبقتها هو عمل بطاقات ثبوتية للموظفين واستخدام وجه البطاقة في الدخول وظهرها في الخروج . ويمنع منعا باتا استخدام لوحة المفاتيح في الإدخال إلا في حالة ضيقة جدا كضياع البطاقة مثلا ، ولكن استخدام لوحة المفاتيح يكون عن طريق صندوق نص آخر وبكلمة مرور وذلك لسد كل الثغرات للتلاعب بالمعلومات .

من الأمور التي أتعبتني بحق هو كيف أجعل البرنامج يتعرف على مصدر الإدخال ، لوحة المفاتيح أو القارئ ، وذلك لأن الكمبيوتر لا يفرق بين الإثنين . حتى فكرت في طريقة لإجبار البرنامج على التمييز بينهما وذلك باحتساب سرعة الإدخال بين رقم وآخر بمعنى لو كان عندنا رقم موظف 102 فسأقوم بدراسة فرق الوقت بين إدخال 1 و 0 وكذلك بين 0 و 2 . فواجهتني مشكلة تشكيك فريق تقنية المعلومات أنه يوجد من يملك سرعة الإدخال مما لن ينفع معها هذا الحقل ، ولكن لأنه لم يوجد حل آخر وكنت شبه مقتنق أن القارئ سوف يكون سريعا جدا مقارنة مع الموظف تم تطبيق الفكرة ونجحت نجاحا مدهشا ولم يستطع أحدا اللحاق بالقارئ .

الأحداث لمعرفة الدخول من الخروج وذلك بعد أن أضيف علامة + للدخول و - للخروج على رقم الموظف في البطاقة فقط وأقوم بتغطية العلامات عند الطباعة .

علما أن أرقام الموظفين المبني عليها الكود تتكون من 3 خانات رقمية فقط .

فارق الوقت والمعرف هنا بالـ Gap ممكن يختلف من جهاز لآخر ، قد يحتاج لتقليله أو زيادته .

Option Compare Database

Dim InTime As Single
Const Gap As Double = 0.02

Private Sub txtBadgeNo_BeforeUpdate(Cancel As Integer)
Select Case Right(Me.txtBadgeNo.Text, 1)
  Case "+"
    Me.GrpInOut = 1
    Me.txtBadgeNo = Left(Me.txtBadgeNo.Text, Len(Me.txtBadgeNo.Text) - 1)
  Case "-"
    Me.GrpInOut = 2
    Me.txtBadgeNo = Left(Me.txtBadgeNo.Text, Len(Me.txtBadgeNo.Text) - 1)
End Select
End Sub


Private Sub txtBadgeNo_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
  If Timer - InTime > Gap Then Me.txtBadgeNo.Tag = ""
  Me.txtBadgeNo.Tag = Right(Me.txtBadgeNo.Tag, 4)
  Me.txtBadgeNo.Text = Me.txtBadgeNo.Tag
  Me.txtBadgeNo.Tag = ""
End If
End Sub

Private Sub txtBadgeNo_KeyPress(KeyAscii As Integer)
Select Case Chr(KeyAscii)
  Case "0" To "9", "+", "-"
    If Me.txtBadgeNo.Tag = "" Then InTime = Timer
    If Timer - InTime <= Gap Then
      Me.txtBadgeNo.Tag = Me.txtBadgeNo.Tag & Chr(KeyAscii)
      InTime = Timer
    Else
      Me.txtBadgeNo.Tag = Chr(KeyAscii)
      InTime = Timer
    End If
  Case Else
    Me.txtBadgeNo.Tag = ""
End Select
End Sub

انتهى كلامه

اختكم

زهره

1

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

السلام عليكم

جوزيتي عنا خيرا أختنا الكريمة زهرة

و اللهم اجعل تعبك في تبسيط المعلومة

و مصابرتك على حل المشكلات

و مساعدة إخوانك في ميزان حسناتك إن شاء الله

ابو رحمة

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

شكرا أخت زهرة على التعاون الكبير الذي أبديتيه

سؤالي اناعندي برنامج متكامل لشؤون الموظفين

ماذا يلزم برمجيا لعمل الباركود

يعني هل في جداول أنشأها للحضور والإنصراف أو كود معين إلخ

ومشكورة سلفاً

تم تعديل بواسطه دبلوم غلبان
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

اخي الكريم

اذا اردت كود الـ VB فقم بعمل التالي

1. بعد تنزيل الملف المرفق وفك الضغط عنه ستجد قاعدة بيانات بإسم BarcodeFunctions يوجد بها الكود في الوحدات النمطيه

2. قم بفتح قاعدة بياناتك وقم بإستيراد الوحده النمطيه من قاعدة البيانات BarcodeFunctions ثم قم يإستدعاءها .

BarcodeFunctions.rar

اما اذا اردت الكود جاهز فقم بنسخ ولصق هذا الكود الى قاعدة بياناتك من خلال انشاء وحده نمطية جديده ووضعه بها " الكود طويل حوالي صفحتين "

'The "Option Compare Database" is only used in Microsoft Access
'Option Compare Database
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts 4.01
'*  Copyright, IDAutomation.com, Inc. 2000-2004. All rights reserved.
'*
'*  Visit [url=http://www.BizFonts.com/vba/]http://www.BizFonts.com/vba/[/url] for more information
'*  about functions in this file.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*
'*  Distributing our source code or fonts outside your
'*  organization requires a Developer License.
'*********************************************************************
'START OF DECLARACTIONS
Private I As Integer
Private F As Integer
Private DataToPrint As String
Private DataToEncode As String
Private OnlyCorrectData As String
Private PrintableString As String
Private Encoding As String
Private WeightedTotal As Long
Private WeightValue As Integer
Private CurrentValue As Long
Private CheckDigitValue As Integer
Private Factor As Integer
Private CheckDigit As Integer
Private CurrentEncoding As String
Private NewLine As String
Private msg As String
Private CurrentChar As String
Private CurrentCharNum As Integer
Private C128_StartA As String
Private C128_StartB As String
Private C128_StartC As String
Private C128_Stop As String
Private C128Start As String
Private C128CheckDigit As String
Private StartCode As String
Private StopCode As String
Private Fnc1 As String
Private LeadingDigit As Integer
Private EAN2AddOn As String
Private EAN5AddOn As String
Private EANAddOnToPrint As String
Private HumanReadableText As String
Private StringLength As Integer
Private CorrectFNC As Integer
'END OF DECLARACTIONS

Public Function Postnet(DataToEncode As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  Visit [url=http://www.BizFonts.com/vba/]http://www.BizFonts.com/vba/[/url] for more information
'*  about functions in this file.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*
'*  Distributing our source code or fonts outside your
'*  organization requires a Developer License.
'*********************************************************************
   DataToPrint = ""
   DataToEncode = RTrim(LTrim(DataToEncode))
' Check to make sure data is numeric and remove dashes, etc.
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
   DataToEncode = OnlyCorrectData
'<<<< Calculate Check Digit >>>>
   WeightedTotal = 0
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Get the value of each number
        CurrentCharNum = Mid(DataToEncode, I, 1)
  'add the values together
        WeightedTotal = WeightedTotal + CurrentCharNum
   Next I
'Find the CheckDigit by finding the number + WeightedTotal that = a multiple of 10
'divide by 10, get the remainder and subtract from 10
   I = (WeightedTotal Mod 10)
   If I <> 0 Then
        CheckDigit = (10 - I)
   Else
        CheckDigit = 0
   End If
'Get Printable String
   DataToPrint = DataToEncode
'ReturnType 0 returns data formatted to the barcode font
   If ReturnType = 0 Then Postnet = "(" & DataToPrint & CheckDigit & ")" & " "
'ReturnType 1 returns data formatted for human readable text
   If ReturnType = 1 Then Postnet = DataToPrint & CheckDigit
'ReturnType 2 returns the  check digit for the data supplied
   If ReturnType = 2 Then Postnet = Str$(CheckDigit)
End Function

Public Function Code128(DataToFormat As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You MUST use the fully functional Code 128 (dated 12/2000 or later)
'*  font for this code to create and print a proper barcode
'*
'*  To create UCC/EAN128 barcodes, call Code128() with the appropriate
'*  ASCII 0202 and AIs included as documented at:
'*  http://www.idautomation.com/code128faq.html#EAN128andUCC128
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
  CorrectFNC = 0
  PrintableString = ""
  'Here we select character set A, B or C for the START character
  StringLength = Len(DataToFormat)
  CurrentCharNum = AscW(Mid(DataToFormat, 1, 1))
  If CurrentCharNum < 32 Then C128Start = ChrW(203)
  If CurrentCharNum > 31 And CurrentCharNum < 127 Then C128Start = ChrW(204)
  If ((StringLength > 4) And IsNumeric(Mid(DataToFormat, 1, 4))) Then C128Start = ChrW(205)
  '202 & 212-215 is for the FNC1, with this Start C is mandatory
  If CurrentCharNum = 202 Then C128Start = ChrW(205)
  If CurrentCharNum = 212 Then C128Start = ChrW(205)
  If CurrentCharNum = 213 Then C128Start = ChrW(205)
  If CurrentCharNum = 214 Then C128Start = ChrW(205)
  If CurrentCharNum = 215 Then C128Start = ChrW(205)
  If C128Start = ChrW(203) Then CurrentEncoding = "A"
  If C128Start = ChrW(204) Then CurrentEncoding = "B"
  If C128Start = ChrW(205) Then CurrentEncoding = "C"
  For I = 1 To StringLength
      'check for FNC1 in any set which is ASCII 202 and ASCII 212-215
      CurrentCharNum = AscW(Mid(DataToFormat, I, 1))
      If ((CurrentCharNum = 202) Or (CurrentCharNum = 212) Or (CurrentCharNum = 213) Or (CurrentCharNum = 214) Or (CurrentCharNum = 215)) Then
          DataToEncode = DataToEncode & ChrW(202)
      'check for switching to character set C
      ElseIf ((I < StringLength - 2) And (IsNumeric(Mid(DataToFormat, I, 1))) And (IsNumeric(Mid(DataToFormat, I + 1, 1))) And (IsNumeric(Mid(DataToFormat, I, 4)))) Or ((I < StringLength) And (IsNumeric(Mid(DataToFormat, I, 1))) And (IsNumeric(Mid(DataToFormat, I + 1, 1))) And (CurrentEncoding = "C")) Then
      'switch to set C if not already in it
          If CurrentEncoding <> "C" Then DataToEncode = DataToEncode & ChrW(199)
          CurrentEncoding = "C"
          CurrentChar = (Mid(DataToFormat, I, 2))
          CurrentValue = CInt(CurrentChar)
      'set the CurrentValue to the number of String CurrentChar
          If (CurrentValue < 95 And CurrentValue > 0) Then DataToEncode = DataToEncode & ChrW(CurrentValue + 32)
          If CurrentValue > 94 Then DataToEncode = DataToEncode & ChrW(CurrentValue + 100)
          If CurrentValue = 0 Then DataToEncode = DataToEncode & ChrW(194)
          I = I + 1
      'check for switching to character set A
      ElseIf (I <= StringLength) And ((AscW(Mid(DataToFormat, I, 1)) < 31) Or ((CurrentEncoding = "A") And (AscW(Mid(DataToFormat, I, 1)) > 32 And (AscW(Mid(DataToFormat, I, 1))) < 96))) Then
      'switch to set A if not already in it
          If CurrentEncoding <> "A" Then DataToEncode = DataToEncode & ChrW(201)
          CurrentEncoding = "A"
      'Get the ASCII value of the next character
          CurrentCharNum = AscW(Mid(DataToFormat, I, 1))
          If CurrentCharNum = 32 Then
              DataToEncode = DataToEncode & ChrW(194)
          ElseIf CurrentCharNum < 32 Then
              DataToEncode = DataToEncode & ChrW(CurrentCharNum + 96)
          ElseIf CurrentCharNum > 32 Then
              DataToEncode = DataToEncode & ChrW(CurrentCharNum)
          End If
      'check for switching to character set B
      ElseIf (I <= StringLength) And ((AscW(Mid(DataToFormat, I, 1))) > 31 And (AscW(Mid(DataToFormat, I, 1)))) < 127 Then
      'switch to set B if not already in it
          If CurrentEncoding <> "B" Then DataToEncode = DataToEncode & ChrW(200)
          CurrentEncoding = "B"
      'Get the ASCII value of the next character
          CurrentCharNum = (AscW(Mid(DataToFormat, I, 1)))
          If CurrentCharNum = 32 Then
              DataToEncode = DataToEncode & ChrW(194)
          Else
              DataToEncode = DataToEncode & ChrW(CurrentCharNum)
          End If
      End If
  Next I
 
  HumanReadableText = ""
'FORMAT TEXT FOR AIs
  StringLength = Len(DataToFormat)
  For I = 1 To StringLength
  CorrectFNC = 0
  'Get ASCII value of each character
      CurrentCharNum = AscW(Mid(DataToFormat, I, 1))
  'Check for FNC1
      If ((I < StringLength - 2) And ((CurrentCharNum = 202) Or ((CurrentCharNum > 211) And (CurrentCharNum < 216)))) Then
      'It appears that there is an AI
      'Get the value of each number pair (ex: 5 and 6 = 5*10+6 =56)
          CurrentChar = (Mid(DataToFormat, I + 1, 2))
          CurrentCharNum = CInt(CurrentChar)
      'Is 2 digit AI by entering ASCII 212?
          If ((CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 212)) Then
              HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 2)) & ") "
              I = I + 2
              CorrectFNC = 1
      'Is 3 digit AI by entering ASCII 213?
          ElseIf ((I < StringLength - 3) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 213)) Then
              HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 3)) & ") "
              I = I + 3
              CorrectFNC = 1
      'Is 4 digit AI by entering ASCII 214?
          ElseIf ((I < StringLength - 4) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 214)) Then
              HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 4)) & ") "
              I = I + 4
              CorrectFNC = 1
      'Is 5 digit AI by entering ASCII 215?
          ElseIf ((I < StringLength - 4) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 215)) Then
              HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 5)) & ") "
              I = I + 5
              CorrectFNC = 1
      'Is 4 digit AI by detection?
          ElseIf ((I < StringLength - 4) And (CorrectFNC = 0) And ((CurrentCharNum <= 81 And CurrentCharNum >= 80) Or (CurrentCharNum <= 34 And CurrentCharNum >= 31))) Then
              HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 4)) & ") "
              I = I + 4
              CorrectFNC = 1
      'Is 3 digit AI by detection?
          ElseIf ((I < StringLength - 3) And (CorrectFNC = 0) And ((CurrentCharNum <= 49 And CurrentCharNum >= 40) Or (CurrentCharNum <= 25 And CurrentCharNum >= 23))) Then
              HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 3)) & ") "
              I = I + 3
              CorrectFNC = 1
      'Is 2 digit AI by detection?
          ElseIf ((CurrentCharNum <= 30 And (CorrectFNC = 0) And CurrentCharNum >= 0) Or (CurrentCharNum <= 99 And CurrentCharNum >= 90)) Then
              HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 2)) & ") "
              I = I + 2
              CorrectFNC = 1
      'If no AI was detected, set default to 4 digit AI:
          ElseIf ((I < StringLength - 4) And (CorrectFNC = 0)) Then
              HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 4)) & ") "
              I = I + 4
              CorrectFNC = 1
          End If
      ElseIf (AscW(Mid(DataToFormat, I, 1)) < 32) Then
          HumanReadableText = HumanReadableText & " "
      ElseIf ((AscW(Mid(DataToFormat, I, 1)) > 31) And (AscW(Mid(DataToFormat, I, 1)) < 128)) Then
          HumanReadableText = HumanReadableText & Mid(DataToFormat, I, 1)
      End If
  Next I
  DataToFormat = ""
  '<<<< Calculate Modulo 103 Check Digit >>>>
  WeightedTotal = AscW(C128Start) - 100
  StringLength = Len(DataToEncode)
  For I = 1 To StringLength
      CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
      If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32
      If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100
      If CurrentCharNum = 194 Then CurrentValue = 0
      CurrentValue = CurrentValue * I
      WeightedTotal = WeightedTotal + CurrentValue
      If CurrentCharNum = 32 Then CurrentCharNum = 194
      PrintableString = PrintableString & ChrW(CurrentCharNum)
  Next I
  CheckDigitValue = (WeightedTotal Mod 103)
  If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
  If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
  If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
  DataToEncode = ""
  'ReturnType 0 returns data formatted to the barcode font
  If ReturnType = 0 Then Code128 = C128Start & PrintableString & C128CheckDigit & ChrW(206) & " "
  'ReturnType 1 returns data formatted for human readable text
  If ReturnType = 1 Then Code128 = HumanReadableText
  'ReturnType 2 returns the check digit for the data supplied
  If ReturnType = 2 Then Code128 = C128CheckDigit
End Function

Public Function Code128a(DataToEncode As String) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You MUST use the fully functional Code 128 (dated 12/2000 or later)
'*  font for this code to create and print a proper barcode
'*
'*  To create UCC/EAN128 barcodes, call Code128() with the appropriate
'*  ASCII 0202 and AIs included as documented at:
'*  http://www.idautomation.com/code128faq.html#EAN128andUCC128
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
   PrintableString = ""
   WeightedTotal = 103
   PrintableString = ChrW(203)
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
        CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
        If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32
        If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100
        CurrentValue = CurrentValue * I
        WeightedTotal = WeightedTotal + CurrentValue
        If CurrentCharNum = 32 Then CurrentCharNum = 194
        PrintableString = PrintableString & ChrW(CurrentCharNum)
   Next I
   CheckDigitValue = (WeightedTotal Mod 103)
   If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
   If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
   If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
   PrintableString = PrintableString & C128CheckDigit & ChrW(206) & " "
   Code128a = PrintableString
End Function

Public Function Code128b(DataToEncode As String) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You MUST use the fully functional Code 128 (dated 12/2000 or later)
'*  font for this code to create and print a proper barcode
'*
'*  To create UCC/EAN128 barcodes, call Code128() with the appropriate
'*  ASCII 0202 and AIs included as documented at:
'*  http://www.idautomation.com/code128faq.html#EAN128andUCC128
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
   PrintableString = ""
   WeightedTotal = 104
   PrintableString = ChrW(204)
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
        CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
        If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32
        If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100
        CurrentValue = CurrentValue * I
        WeightedTotal = WeightedTotal + CurrentValue
        If CurrentCharNum = 32 Then CurrentCharNum = 194
        PrintableString = PrintableString & ChrW(CurrentCharNum)
   Next I
   CheckDigitValue = (WeightedTotal Mod 103)
   If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
   If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
   If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
   PrintableString = PrintableString & C128CheckDigit & ChrW(206) & " "
   Code128b = PrintableString
End Function

Public Function Code128c(DataToEncode As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You MUST use the fully functional Code 128 (dated 12/2000 or later)
'*  font for this code to create and print a proper barcode
'*
'*  To create UCC/EAN128 barcodes, call Code128() with the appropriate
'*  ASCII 0202 and AIs included as documented at:
'*  http://www.idautomation.com/code128faq.html#EAN128andUCC128
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************

   PrintableString = ""
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
   DataToEncode = OnlyCorrectData
   If (Len(DataToEncode) Mod 2) = 1 Then DataToEncode = "0" & DataToEncode
   PrintableString = ChrW(205)
   WeightedTotal = 105
   WeightValue = 1
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength Step 2
        CurrentValue = Mid(DataToEncode, I, 2)
        If CurrentValue < 95 And CurrentValue > 0 Then PrintableString = PrintableString & ChrW(CurrentValue + 32)
        If CurrentValue > 94 Then PrintableString = PrintableString & ChrW(CurrentValue + 100)
        If CurrentValue = 0 Then PrintableString = PrintableString & ChrW(194)
        CurrentValue = CurrentValue * WeightValue
        WeightedTotal = WeightedTotal + CurrentValue
        WeightValue = WeightValue + 1
   Next I
   CheckDigitValue = (WeightedTotal Mod 103)
   If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
   If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
   If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
   If ReturnType = 0 Then Code128c = PrintableString & C128CheckDigit & ChrW(206) & " "
   If ReturnType = 1 Then Code128c = DataToEncode & CheckDigitValue
   If ReturnType = 2 Then Code128c = Str(CheckDigitValue)
End Function

Public Function I2of5(DataToEncode As String) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
   DataToPrint = ""
   DataToEncode = RTrim(LTrim(DataToEncode))
' Check to make sure data is numeric and remove dashes, etc.
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
   DataToEncode = OnlyCorrectData
'Check for an even number of digits, add 0 if not even
   If (Len(DataToEncode) Mod 2) = 1 Then DataToEncode = "0" & DataToEncode
'Assign start and stop codes
   StartCode = ChrW(203)
   StopCode = ChrW(204)
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength Step 2
  'Get the value of each number pair
        CurrentCharNum = Val((Mid(DataToEncode, I, 2)))
  'Get the ASCII value of CurrentChar according to chart by to the value
        If CurrentCharNum < 94 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 33)
        If CurrentCharNum > 93 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 103)
   Next I
'Get Printable String
   PrintableString = StartCode + DataToPrint + StopCode & " "
'Return PrintableString
   I2of5 = PrintableString
End Function

Public Function USPS_EAN128(DataToEncode As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
'
' Used for 22 digit USPS special services labels such as delivery confirmation in
' EAN128 with Code 128 fonts. This new EAN128 format is mandatory as of
' January 10, 2004 according to the USPS Delivery Confirmation Service
' defined in the September 2002 version of Publication 91. Enter a 19 or
' 20 digit number; only the first 19 are used. This number is made up of
' the following:  2 digit service code + 9 digit customer ID + 8 digit
' sequential package ID + MOD 10 check digit that can be calculated by
' this function if excluded. In this function, the application identifier
' of 91 is automatically added for you.
'
' Other USPS EAN128 barcode types must be created by calling Code128() with the appropriate
' ASCII 0202 and AIs included as documented at:
' [url=http://www.idautomation.com/code128faq.html#EAN128andUCC128]http://www.idautomation.com/code128faq.html#EAN128andUCC128[/url]
'
' Check to make sure data is numeric and remove dashes, etc.
   OnlyCorrectData = ""
   Dim DataForCheck As String
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
'Remove check digits and (AI) if they were added to input
   If Len(OnlyCorrectData) > "19" Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 19))
'End sub if incorrect number
   If Len(OnlyCorrectData) <> "19" Then OnlyCorrectData = "0000000000000000000"
'Add in the AI of 91
   DataToEncode = "91" & OnlyCorrectData
'Get the MOD 10 Check Digit
   CheckDigit = MOD10(DataToEncode)
'Now that we have calculated the MOD 10 for the data, send the string
'to the Code128() funtion. This function will:
' - Add in the start and stop codes
' - Add in the AI and START C
' - Calculate the MOD 103 required when using Code 128
' - Interleave the numbers into printable characters
'ReturnType 0 returns data formatted to the barcode font
   If ReturnType = 0 Then USPS_EAN128 = Code128(ChrW(202) & DataToEncode & CheckDigit, 0)
'ReturnType 1 returns data formatted for human readable text
   If ReturnType = 1 Then USPS_EAN128 = Mid(DataToEncode, 1, 4) & " " & Mid(DataToEncode, 5, 4) & " " & Mid(DataToEncode, 9, 4) & " " & Mid(DataToEncode, 13, 4) & " " & Mid(DataToEncode, 17, 4) & " " & Mid(DataToEncode, 21, 1) & CheckDigit
'ReturnType 2 returns the MOD10 check digit for the data supplied
   If ReturnType = 2 Then USPS_EAN128 = Str(CheckDigit)
End Function

Public Function Code39Mod43(DataToEncode As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
   'DataToEncode = RTrim(DataToEncode)
   DataToEncode = UCase(DataToEncode)
   DataToPrint = ""
   OnlyCorrectData = ""
'only pass correct data
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Get each character one at a time
        CurrentCharNum = (AscW(Mid(DataToEncode, I, 1)))
  'Get the value of CurrentChar according to MOD43
  '0-9
        If CurrentCharNum < 58 And CurrentCharNum > 47 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  'A-Z
        If CurrentCharNum < 91 And CurrentCharNum > 64 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  'Space
        If CurrentCharNum = 32 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  '-
        If CurrentCharNum = 45 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  '.
        If CurrentCharNum = 46 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  '$
        If CurrentCharNum = 36 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  '/
        If CurrentCharNum = 47 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  '+
        If CurrentCharNum = 43 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  '%
        If CurrentCharNum = 37 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
   DataToEncode = OnlyCorrectData
   WeightedTotal = 0
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Get each character one at a time
        CurrentCharNum = (AscW(Mid(DataToEncode, I, 1)))
  'Get the value of CurrentChar according to MOD43
  '0-9
        If CurrentCharNum < 58 And CurrentCharNum > 47 Then CurrentValue = CurrentCharNum - 48
  'A-Z
        If CurrentCharNum < 91 And CurrentCharNum > 64 Then CurrentValue = CurrentCharNum - 55
  'Space
        If CurrentCharNum = 32 Then CurrentValue = 38
  '-
        If CurrentCharNum = 45 Then CurrentValue = 36
  '.
        If CurrentCharNum = 46 Then CurrentValue = 37
  '$
        If CurrentCharNum = 36 Then CurrentValue = 39
  '/
        If CurrentCharNum = 47 Then CurrentValue = 40
  '+
        If CurrentCharNum = 43 Then CurrentValue = 41
  '%
        If CurrentCharNum = 37 Then CurrentValue = 42
  'To print the barcode symbol representing a space you will
  'to type or print "=" (the equal character) instead of a space character.
        If CurrentCharNum = 32 Then CurrentCharNum = 61
  'gather data to print
        DataToPrint = DataToPrint & ChrW(CurrentCharNum)
  'add the values together
        WeightedTotal = WeightedTotal + CurrentValue
   Next I
'divide the WeightedTotal by 43 and get the remainder, this is the CheckDigit
   CheckDigitValue = (WeightedTotal Mod 43)
  'Assign values to characters
  '0-9
   If CheckDigitValue < 10 Then CheckDigit = CheckDigitValue + 48
  'A-Z
   If CheckDigitValue < 36 And CheckDigitValue > 9 Then CheckDigit = CheckDigitValue + 55
  'Space
   If CheckDigitValue = 38 Then CheckDigit = 61
  '-
   If CheckDigitValue = 36 Then CheckDigit = 45
  '.
   If CheckDigitValue = 37 Then CheckDigit = 46
  '$
   If CheckDigitValue = 39 Then CheckDigit = 36
  '/
   If CheckDigitValue = 40 Then CheckDigit = 47
  '+
   If CheckDigitValue = 41 Then CheckDigit = 43
  '%
   If CheckDigitValue = 42 Then CheckDigit = 37
   
'ReturnType 0 returns data formatted to the barcode font
   If ReturnType = 0 Then Code39Mod43 = "!" & DataToPrint & ChrW(CheckDigit) & "!" & " "
'ReturnType 1 returns data formatted for human readable text
   If ReturnType = 1 Then Code39Mod43 = DataToPrint & ChrW(CheckDigit)
'ReturnType 2 returns the  check digit for the data supplied
   If ReturnType = 2 Then Code39Mod43 = ChrW(CheckDigit)
End Function

Public Function Code39(DataToEncode As String) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************

   DataToPrint = ""
   DataToEncode = RTrim(LTrim(DataToEncode))
'Check for spaces in code
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Get each character one at a time
        CurrentChar = (Mid(DataToEncode, I, 1))
  'To print the barcode symbol representing a space you will
  'to type or print "=" (the equal character) instead of a space character.
        If CurrentChar = " " Then CurrentChar = "="
        DataToPrint = DataToPrint & CurrentChar
   Next I
'Get Printable String
   PrintableString = "!" & DataToPrint & "!" & " "
'Return PrintableString
   Code39 = PrintableString
End Function

Public Function I2of5Mod10(DataToEncode As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************

' Get data from user, this is the DataToEncode
   DataToEncode = RTrim(LTrim(DataToEncode))
   DataToPrint = ""
' Check to make sure data is numeric and remove dashes, etc.
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
   DataToEncode = OnlyCorrectData
'<<<< Calculate Check Digit >>>>
   Factor = 3
   WeightedTotal = 0
   For I = Len(DataToEncode) To 1 Step -1
  'Get the value of each number starting at the end
        CurrentCharNum = Mid(DataToEncode, I, 1)
  'multiply by the weighting factor which is 3,1,3,1...
  'and add the sum together
        WeightedTotal = WeightedTotal + CurrentCharNum * Factor
  'change factor for next calculation
        Factor = 4 - Factor
   Next I
'Find the CheckDigit by finding the smallest number that = a multiple of 10
   I = (WeightedTotal Mod 10)
   If I <> 0 Then
        CheckDigit = (10 - I)
   Else
        CheckDigit = 0
   End If
'Add check digit to number to DataToEncode
   DataToEncode = DataToEncode & CheckDigit
'Check for an even number of digits, add 0 if not even
   If (Len(DataToEncode) Mod 2) = 1 Then DataToEncode = "0" & DataToEncode
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength Step 2
  'Get the value of each number pair
        CurrentCharNum = (Mid(DataToEncode, I, 2))
  'Get the ASCII value of CurrentChar according to chart by to the value
        If CurrentCharNum < 94 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 33)
        If CurrentCharNum > 93 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 103)
   Next I
'ReturnType 0 returns data formatted to the barcode font
   If ReturnType = 0 Then I2of5Mod10 = ChrW(203) & DataToPrint & ChrW(204) & " "
'ReturnType 1 returns data formatted for human readable text
   If ReturnType = 1 Then I2of5Mod10 = DataToEncode
'ReturnType 2 returns the  check digit for the data supplied
   If ReturnType = 2 Then I2of5Mod10 = Str$(CheckDigit)
End Function

Public Function MSI(DataToEncode As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************

' The MSI encoding function will only accept digits.  Any non-numeric characters
' will be discarded
  Dim DataToPrint As String       'output for function
  Dim OnlyCorrectData As String   'Only numeric characters pulled from DataToEncode
  Dim StringLength As Long        'Length of string
  Dim Idx As Integer              'for loop counter
  Dim OddNumbers As String        'String of odd position numbers used to create check digit
  Dim EvenNumberSum As Long       'all of the even position numbers added up
  Dim OddNumberProduct As Long    'Product of OddNumbers variable
  Dim sOddNumberProduct As String 'String version of OddNumberProduct variable
  Dim OddNumberSum As Long        'Sum of individual digits in sOddNumberProduct
  Dim OddDigit As Boolean         'Used to determine even/odd position digits.
  Dim CheckDigit As String        'This is the CheckDigit
  DataToPrint = ""
  OnlyCorrectData = ""
  'Take off any extra spaces
  DataToEncode = Trim(DataToEncode)
 
  'Check to make sure data is numeric and remove dashes, etc.
   StringLength = Len(DataToEncode)
   For Idx = 1 To StringLength
      'Add all numbers to OnlyCorrectData string
      If IsNumeric(Mid(DataToEncode, Idx, 1)) = True Then
          OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, Idx, 1)
      End If
   Next Idx
   
   DataToEncode = OnlyCorrectData
   
   '<<<< Calculate Check Digit >>>>
   'To create the check digit follow these steps
   '1)Starting from the units position, create a new number with all of the odd
   '  position digits in their original sequence.
   '2)Multiply this new number by 2.
   '3)Add all of the digits of the product from step two.
   '4)Add all of the digits not used in step one to the result in step three.
   '5)Determine the smallest number which when added to the result in step four
   '  will result in a multiple of 10. This is the check character.

  'Step 1 -- Create a new number of the odd position digits starting from the right and going left, but store the
  'digits from left to right.
  'We will create the odd position number & prepare for Step 4 by getting the sum of all even position charactesr
  StringLength = Len(DataToEncode)
  OddNumbers = ""
  OddDigit = True
  EvenNumberSum = 0
  For Idx = StringLength To 1 Step -1
      If OddDigit = True Then
          OddNumbers = Mid(DataToEncode, Idx, 1) & OddNumbers
          OddDigit = False
      Else
          EvenNumberSum = EvenNumberSum + Val(Mid(DataToEncode, Idx, 1))
          OddDigit = True
      End If
  Next Idx
 
  'Step 2 -- Multiply this new number by 2.
  OddNumberProduct = Val(OddNumbers) * 2

  'Step 3 -- Add all of the digits of the product from step two.
  sOddNumberProduct = Format(OddNumberProduct)
  StringLength = Len(sOddNumberProduct)
  OddNumberSum = 0

  For Idx = 1 To StringLength
      OddNumberSum = OddNumberSum + Val(Mid(sOddNumberProduct, Idx, 1))
  Next Idx
 
  'Step 4 -- Add all of the digits not used in step one to the result in step three.
  'We will store the result in OddNumberSum just so we don't have to create another variable
  OddNumberSum = OddNumberSum + EvenNumberSum
 
  'Step 5 -- Determine the smallest number which when added to the result in step four
  '  will result in a multiple of 10. This is the check character.
  OddNumberSum = OddNumberSum Mod 10
  If OddNumberSum <> 0 Then
      CheckDigit = Format(10 - OddNumberSum)
  Else
      CheckDigit = "0"
  End If
 
  Select Case ReturnType
      Case 0  'Returns formatted data for barcode
          DataToPrint = "(" & DataToEncode & CheckDigit & ")" & " "
      Case 1  'Returns data formatted for human readable text.  Which means all of the invalid characters where
              'stripped out.
          DataToPrint = DataToEncode
      Case 2  'Returns just the check digit
          DataToPrint = CheckDigit
  End Select
 
  MSI = DataToPrint
 
End Function

تابع بقية الكود قي الاسفل

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

Public Function SSCC18(DataToEncode As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
'
' To create more complex UCC/EAN128 barcodes, call Code128() with the appropriate
' ASCII 0202 and AIs included as documented at:
' http://www.idautomation.com/code128faq.html#EAN128andUCC128
'
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
'Remove check digits and (AI) if they were added to input
   If Len(OnlyCorrectData) = "18" Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 17))
   If Len(OnlyCorrectData) = "19" Then OnlyCorrectData = (Mid(OnlyCorrectData, 3, 17))
   If Len(OnlyCorrectData) = "20" Then OnlyCorrectData = (Mid(OnlyCorrectData, 3, 17))
   If Len(OnlyCorrectData) = "21" Then OnlyCorrectData = (Mid(OnlyCorrectData, 3, 17))
'End sub if incorrect number
   If Len(OnlyCorrectData) <> "17" Then OnlyCorrectData = "0000000000000"
   DataToEncode = OnlyCorrectData
'<<<< Generate MOD 10 check digit >>>>
   Factor = 3
   WeightedTotal = 0
   StringLength = Len(DataToEncode)
   For I = StringLength To 1 Step -1
  'Get the value of each number starting at the end
        CurrentCharNum = Mid(DataToEncode, I, 1)
  'multiply by the weighting factor which is 3,1,3,1...
  'and add the sum together
        WeightedTotal = WeightedTotal + CurrentCharNum * Factor
  'change factor for next calculation
        Factor = 4 - Factor
   Next I
'Find the CheckDigit by finding the smallest number that = a multiple of 10
   I = (WeightedTotal Mod 10)
   If I <> 0 Then
        CheckDigit = (10 - I)
   Else
        CheckDigit = 0
   End If
'Add check digit and Application Identifier (AI) to DataToEncode
'AI = 00 for SSCC18
'DataToEncode = "00" & DataToEncode & CheckDigit
'Now that we have calculated the MOD 10 for the data, send the string
'to the UCC128() funtion. This function will:
' - Add in the Start C and FNC1 required by UCC/EAN
' - Calculate the MOD 103 required by UCC/EAN
' - Interleave the numbers into printable characters
'ReturnType 0 returns data formatted to the barcode font
   If ReturnType = 0 Then SSCC18 = UCC128("00" & DataToEncode & CheckDigit)
'ReturnType 1 returns data formatted for human readable text
   If ReturnType = 1 Then SSCC18 = "(00) " & Mid(DataToEncode, 1, 1) & " " & Mid(DataToEncode, 2, 7) & " " & Mid(DataToEncode, 9, 9) & " " & CheckDigit
'ReturnType 2 returns the MOD10 check digit for the data supplied
   If ReturnType = 2 Then SSCC18 = Str(CheckDigit)
End Function


Public Function SCC14(DataToEncode As String, ReturnType As Integer) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
'
' To create more complex UCC/EAN128 barcodes, call Code128() with the appropriate
' ASCII 0202 and AIs included as documented at:
' http://www.idautomation.com/code128faq.html#EAN128andUCC128
'
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
'Remove check digits and (AI) if they were added to input
   If Len(OnlyCorrectData) = "14" Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 13))
   If Len(OnlyCorrectData) = "15" Then OnlyCorrectData = (Mid(OnlyCorrectData, 3, 13))
   If Len(OnlyCorrectData) = "16" Then OnlyCorrectData = (Mid(OnlyCorrectData, 3, 13))
   If Len(OnlyCorrectData) = "17" Then OnlyCorrectData = (Mid(OnlyCorrectData, 3, 13))
'End sub if incorrect number
   If Len(OnlyCorrectData) <> "13" Then OnlyCorrectData = "0000000000000"
   DataToEncode = OnlyCorrectData
'<<<< Generate MOD 10 check digit >>>>
   Factor = 3
   WeightedTotal = 0
   StringLength = Len(DataToEncode)
   For I = StringLength To 1 Step -1
  'Get the value of each number starting at the end
        CurrentCharNum = Mid(DataToEncode, I, 1)
  'multiply by the weighting factor which is 3,1,3,1...
  'and add the sum together
        WeightedTotal = WeightedTotal + CurrentCharNum * Factor
  'change factor for next calculation
        Factor = 4 - Factor
   Next I
'Find the CheckDigit by finding the smallest number that = a multiple of 10
   I = (WeightedTotal Mod 10)
   If I <> 0 Then
        CheckDigit = (10 - I)
   Else
        CheckDigit = 0
   End If
'Add check digit and Application Identifier (AI) to DataToEncode
'AI = 00 for SSCC18
'DataToEncode = "00" & DataToEncode & CheckDigit
'Now that we have calculated the MOD 10 for the data, send the string
'to the UCC128() funtion. This function will:
' - Add in the Start C and FNC1 required by UCC/EAN
' - Calculate the MOD 103 required by UCC/EAN
' - Interleave the numbers into printable characters
'ReturnType 0 returns data formatted to the barcode font
   If ReturnType = 0 Then SCC14 = UCC128("01" & DataToEncode & CheckDigit)
'ReturnType 1 returns data formatted for human readable text
   If ReturnType = 1 Then SCC14 = "(01) " & Mid(DataToEncode, 1, 1) & " " & Mid(DataToEncode, 2, 7) & " " & Mid(DataToEncode, 9, 5) & " " & CheckDigit
'ReturnType 2 returns the MOD10 check digit for the data supplied
   If ReturnType = 2 Then SCC14 = Str(CheckDigit)
End Function


Public Function UCC128(DataToEncode As String) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
'
' NOTE:
' This is an older and less flexible method for creating UCC/EAN 128 barcodes
' because it only enters one FNC1 code before the numbers. If you need more than one FNC1,
' the UCC/EAN128 should be created by calling Code128() with the appropriate
' ASCII 0202 and AIs included as documented at:
' http://www.idautomation.com/code128faq.html#EAN128andUCC128
'
' You MUST use the fully functional Code 128 (dated 12/2000 or later)
' font for this code to create and print a proper barcode
'
   DataToPrint = ""
   DataToEncode = RTrim(LTrim(DataToEncode))
' Check to make sure data is numeric or "FA" and remove all others.
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength Step 2
  'Add all numbers and "FA" to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 2)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 2)
        If Mid(DataToEncode, I, 2) = "FA" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 2)
   Next I
   DataToEncode = OnlyCorrectData
'Assign start, stop and FNC1 codes
   StartCode = ChrW(205)
   StopCode = ChrW(206)
   Fnc1 = ChrW(202)
' CurrentValue
'<<<< Calculate Modulo 103 Check Digit and generate DataToPrint >>>>
'Set WeightedTotal to the Code 128 value of the start character + Fnc1
   WeightedTotal = 105 + 102
   WeightValue = 2
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength Step 2
  'Get the value of each number pair
        CurrentChar = Mid(DataToEncode, I, 2)
  'get the DataToPrint
        If CurrentChar <> "FA" Then
      'set the Integer CurrentValue to the number of String CurrentChar
             CurrentValue = CInt(CurrentChar)
             If CurrentValue < 95 And CurrentValue > 0 Then DataToPrint = DataToPrint & ChrW(CurrentValue + 32)
             If CurrentValue > 94 Then DataToPrint = DataToPrint & ChrW(CurrentValue + 100)
             If CurrentValue = 0 Then DataToPrint = DataToPrint & ChrW(194)
        Else
             If CurrentChar = "FA" Then DataToPrint = DataToPrint & ChrW(202)
        End If
  'multiply by the weighting character
        If CurrentChar <> "FA" Then CurrentValue = CurrentValue * WeightValue
        If CurrentChar = "FA" Then CurrentValue = 102 * WeightValue
  'add the values together to get the weighted total
        WeightedTotal = WeightedTotal + CurrentValue
        WeightValue = WeightValue + 1
   Next I
'divide the WeightedTotal by 103 and get the remainder, this is the CheckDigitValue
   CheckDigitValue = (WeightedTotal Mod 103)
'Now that we have the CheckDigitValue, find the corresponding ASCII character from the table
   If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
   If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
   If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
'Get Printable String
   PrintableString = StartCode & Fnc1 & DataToPrint & C128CheckDigit & StopCode & " "
'Return PrintableString
   UCC128 = PrintableString
End Function

Public Function Code11(DataToEncode As String) As String
' Copyright © 2000-2003 IDautomation.com, Inc.
' For more info visit http://www.IDAutomation.com
'
' You may use our source code in your applications only if you are using barcode fonts
' created by IDautomation.com, Inc. and you do not remove the copyright notices in the source code.
   DataToPrint = ""
   DataToEncode = RTrim(LTrim(DataToEncode))
' Check to make sure data is numeric or a dash and remove all others.
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
        If Mid(DataToEncode, I, 1) = "-" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
   DataToEncode = OnlyCorrectData
'<<<< Calculate Check Digit >>>>
   Factor = 1
   WeightedTotal = 0
   For I = Len(DataToEncode) To 1 Step -1
  'Get the value of each number starting at the end
        CurrentChar = Mid(DataToEncode, I, 1)
  'Set the "-" character to the value of 10
        If CurrentChar = "-" Then CurrentChar = "10"
  'multiply by the weighting character and add together
        WeightedTotal = WeightedTotal + (Val(CurrentChar) * Factor)
  'change factor for next calculation
        Factor = Factor + 1
   Next I
'Find the Modulo 11 check digit
   CheckDigit = (WeightedTotal Mod 11)
'Get Printable String
   PrintableString = "(" & DataToEncode & CheckDigit & ")" & " "
'Return the PrintableString
   Code11 = PrintableString
End Function

Public Function RM4SCC(DataToEncode As String) As String
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
' Get data from user, this is the DataToEncode
   DataToEncode = RTrim(LTrim(DataToEncode))
   DataToEncode = UCase(DataToEncode)
'only pass correct data
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Get each character one at a time
        CurrentCharNum = (AscW(Mid(DataToEncode, I, 1)))
  'Get the value of CurrentChar according to MOD43
  '0-9
        If CurrentCharNum < 58 And CurrentCharNum > 47 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  'A-Z
        If CurrentCharNum < 91 And CurrentCharNum > 64 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
   DataToEncode = OnlyCorrectData
   DataToPrint = DataToEncode
   
   Dim r As Integer
   Dim c As Integer
   Dim Rtotal As Long
   Dim Ctotal As Long
   Rtotal = 0
   Ctotal = 0
   WeightedTotal = 0
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Get each character one at a time
        CurrentChar = Mid(DataToEncode, I, 1)
  'Get the values of CurrentChar
        Select Case CurrentChar
        Case "0"
             r = 1
             c = 1
        Case "1"
             r = 1
             c = 2
        Case "2"
             r = 1
             c = 3
        Case "3"
             r = 1
             c = 4
        Case "4"
             r = 1
             c = 5
        Case "5"
             r = 1
             c = 0
        Case "6"
             r = 2
             c = 1
        Case "7"
             r = 2
             c = 2
        Case "8"
             r = 2
             c = 3
        Case "9"
             r = 2
             c = 4
        Case "A"
             r = 2
             c = 5
        Case "B"
             r = 2
             c = 0
        Case "C"
             r = 3
             c = 1
        Case "D"
             r = 3
             c = 2
        Case "E"
             r = 3
             c = 3
        Case "F"
             r = 3
             c = 4
        Case "G"
             r = 3
             c = 5
        Case "H"
             r = 3
             c = 0
        Case "I"
             r = 4
             c = 1
        Case "J"
             r = 4
             c = 2
        Case "K"
             r = 4
             c = 3
        Case "L"
             r = 4
             c = 4
        Case "M"
             r = 4
             c = 5
        Case "N"
             r = 4
             c = 0
        Case "O"
             r = 5
             c = 1
        Case "P"
             r = 5
             c = 2
        Case "Q"
             r = 5
             c = 3
        Case "R"
             r = 5
             c = 4
        Case "S"
             r = 5
             c = 5
        Case "T"
             r = 5
             c = 0
        Case "U"
             r = 0
             c = 1
        Case "V"
             r = 0
             c = 2
        Case "W"
             r = 0
             c = 3
        Case "X"
             r = 0
             c = 4
        Case "Y"
             r = 0
             c = 5
        Case "Z"
             r = 0
             c = 0
             
        End Select
  'add the values together
        Rtotal = Rtotal + r
        Ctotal = Ctotal + c
   Next I
   
'divide the Totals by 6 and get the remainder, this is a reference
'to the Check Digit.
'set check digit to CurrentChar (a string)
   Rtotal = (Rtotal Mod 6)
   Ctotal = (Ctotal Mod 6)
   Select Case Rtotal
   Case 1
        Select Case Ctotal
        Case 1
             CurrentChar = "0"
        Case 2
             CurrentChar = "1"
        Case 3
             CurrentChar = "2"
        Case 4
             CurrentChar = "3"
        Case 5
             CurrentChar = "4"
        Case 0
             CurrentChar = "5"
        End Select
   Case 2
        Select Case Ctotal
        Case 1
             CurrentChar = "6"
        Case 2
             CurrentChar = "7"
        Case 3
             CurrentChar = "8"
        Case 4
             CurrentChar = "9"
        Case 5
             CurrentChar = "A"
        Case 0
             CurrentChar = "B"
        End Select
   Case 3
        Select Case Ctotal
        Case 1
             CurrentChar = "C"
        Case 2
             CurrentChar = "D"
        Case 3
             CurrentChar = "E"
        Case 4
             CurrentChar = "F"
        Case 5
             CurrentChar = "G"
        Case 0
             CurrentChar = "H"
        End Select
   Case 4
        Select Case Ctotal
        Case 1
             CurrentChar = "I"
        Case 2
             CurrentChar = "J"
        Case 3
             CurrentChar = "K"
        Case 4
             CurrentChar = "L"
        Case 5
             CurrentChar = "M"
        Case 0
             CurrentChar = "N"
        End Select
   Case 5
        Select Case Ctotal
        Case 1
             CurrentChar = "O"
        Case 2
             CurrentChar = "P"
        Case 3
             CurrentChar = "Q"
        Case 4
             CurrentChar = "R"
        Case 5
             CurrentChar = "S"
        Case 0
             CurrentChar = "T"
        End Select
   Case 0
        Select Case Ctotal
        Case 1
             CurrentChar = "U"
        Case 2
             CurrentChar = "V"
        Case 3
             CurrentChar = "W"
        Case 4
             CurrentChar = "X"
        Case 5
             CurrentChar = "Y"
        Case 0
             CurrentChar = "Z"
        End Select
   End Select
'Get Printable String
   PrintableString = "(" & DataToPrint & CurrentChar & ")" & " "
'Return PrintableString
   RM4SCC = PrintableString
End Function


Public Function Codabar(DataToEncode As String) As String
' Copyright © 2000-2003 IDautomation.com, Inc.
' For more info visit http://www.IDAutomation.com
'
' You may use our source code in your applications only if you are using barcode fonts
' created by IDautomation.com, Inc. and you do not remove the copyright notices in the source code.
   DataToPrint = ""
   DataToEncode = RTrim(LTrim(DataToEncode))
   
' Check to make sure data is numeric, $, +, -, /, or :, and remove all others.
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
  'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
        If Mid(DataToEncode, I, 1) = "$" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
        If Mid(DataToEncode, I, 1) = "+" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
        If Mid(DataToEncode, I, 1) = "-" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
        If Mid(DataToEncode, I, 1) = "/" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
        If Mid(DataToEncode, I, 1) = "." Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
        If Mid(DataToEncode, I, 1) = ":" Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
   DataToPrint = OnlyCorrectData
'Get Printable String
   PrintableString = "A" & DataToPrint & "B" & " "
'Return PrintableString
   Codabar = PrintableString
End Function


Public Function MOD10(DataToEncode As String) As String
' This is a general MOD10 function like the one required for EAN and UPC
'*********************************************************************
'*  Visual Basic / VBA Functions for Bar Code Fonts
'*  Copyright, IDAutomation.com, Inc. All rights reserved.
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid license from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*********************************************************************
   OnlyCorrectData = ""
   StringLength = Len(DataToEncode)
   For I = 1 To StringLength
      'Add all numbers to OnlyCorrectData string
        If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
   Next I
'<<<< Generate MOD 10 check digit >>>>
   Factor = 3
   WeightedTotal = 0
   StringLength = Len(DataToEncode)
   For I = StringLength To 1 Step -1
  'Get the value of each number starting at the end
        CurrentCharNum = Mid(DataToEncode, I, 1)
  'multiply by the weighting factor which is 3,1,3,1...
  'and add the sum together
        WeightedTotal = WeightedTotal + CurrentCharNum * Factor
  'change factor for next calculation
        Factor = 4 - Factor
   Next I
'Find the CheckDigit by finding the smallest number that = a multiple of 10
   I = (WeightedTotal Mod 10)
   If I <> 0 Then
        CheckDigit = (10 - I)
   Else
        CheckDigit = 0
   End If
   MOD10 = Str(CheckDigit)
End Function

طبعا هذا الكود يتعرف على انواع الخطوط المستخدمه سواء خط CODE128 او خط CODE139 وغيرها من الخطوط وكذلك على المخارج سواء كانت COM او USB او PS2 وغيرها من المخارج وايضا يتعرف على انواع السكانرات الخاصه بالباركود

المصدر

http://www.idautomation.com

اختكم

زهره

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

مشكورة الأخت زهرة

وباجرب وباشتغل على الكود وباقولكم بالنتايج

مرة وشكرا مرة أخرى

تم تعديل بواسطه دبلوم غلبان
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1
اعزائي الكرام

السلام عليكم ورحمة الله وبركاته

كثرت الاسئلة عن استخدام الباركود مع برنامج الاكسيس لهذا نضع بين ايديكم الحل الامثل والطريقة تتمثل في التالي

اولا : ما هو الباركود " لم اجد تعبيرا افضل من تعبير استاذنا طارق حنيدق حيث قال "

هى وسيلة بسيطة لتعريف الارقام يسهل معها استعادة الرقم بجهاز قارئ للباركود ومنذ اختراعه له استخدامات عديدة المخازن الكارنيهات والبطاقات وايضا فى السوبرماركت حيث انه يوفر الوقت باستخدام جهاز القارئ ومنه يعطى اسم الصنف وسعرة واى بيانات اخرى وما على المستخدم الكاشير الا ان يدخل الكمية فقط وبالتالى يكون استخدام الموضوع له اهمية

واهميته فى الاكسس اننا كمبرمجين اكسس لانحب ان نلجأ الى حلول برمجية من خارج الاكسس لحبنا الاكسس هذا اولا ثم اعتقاد منى والله اعلم اننا لسنا فى حاجة الى حلول من خارج الاكسس والا نبحث عن لغة برمجة اخرى وان كنت من واقع خبرتى لايوجد مايضاهى الاكسس من حيث سهولة الاستخدام وواقعية التنفيذ وخاصة مع دخول ADO و SQL2000

( مع احترامى الشديد لمبرمجى اوراكل ودلفى ) انتهى كلامه ..

المعدات اللازمه لذلك

1. قارئة باركود

IDAutomation_USB_Barcode_Scanner.jpg

2. طابعة باركود لطباعة الملصقات بعد اخراجها من التقرير

Thermal_Bar_Code_Label_Printer.jpg

3. ورق وملصقات

Barcode_Label_Software.jpg

4.خطوط خاصة بالباركود مثل خط Code39 وخط Code128

لتحميل الخطوط

ALLBarcode Font.rar

IDAutomationCode39.zip

5. برنامج اكسيس مع الاداة الخاصة بالباركود

طريقة تسجيل الاداة barcodex.ocx في الويندوز ليقبلها الاكسيس

1. بعد تحميل الاداة من الملف المرفق قم بنسخ الاداة الى مجلد C:\WINDOWS\system32

2. اذهب الى ابدأ واختر تشغيل وضع هذا الامر في المربع الحواري الظاهر امامك

regsvr32 "C:\WINDOWS\system32\barcodex.ocx"

3. اضغط موافق وسيتم تسجيل الاداة وظهور رسالة تفيد بإتمام عملية التسجيل بنجاح

4. الان افتح ملف الاكسيس المرفق وانظر النتيجه

barcodex.rar

ملاحظة : تستطيع كتابة الارقام والحروف مثل 100-25-10001 او zahrah او arabteam2000 او 123456789 ثم الضغط على انتر Enter في لوحة المفاتيح وستجد البرنامج يقوم بإظهار رمز الباركود المقابل له في النموذج

اختكم

زهره

شكرا جزيلا

اتبعت الخطوات ولكن لم يفتح البرنامج فما الحل

1

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

الأخت الفاضلة زهرة بارك الله فيك ونفع بك امة الاسلام

السلام عليكم ورحمة الله وبركاته

نرجو المزيد من الأمثلة على الباركود أختنا العزيزة

وجزاكم الله خيرا

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

لا يعلم فضل أهل الفضل إلا أهل الفضل ...

وجزاك الله عنا خير الجزاء

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

زهرة المنتديات العربية

تحية طيبه

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

شكرا لك

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

الاستاذه العظيمة جدا المحترمه جدا زهره

الف شكر على هذا الموضوع وجزاك الله عنا خير الجزاء

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • -1

بارك الله فيك يا أختى الكريمة وزادك علما

0

شارك هذا الرد


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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .