الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

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

رائج
بدأه zahrah في 13 أكتوبر 2005 · 65 رد · 81,934 مشاهدة · في قواعد بيانات Microsoft Access
مشاركة: واتساب X فيسبوك تيليجرام
#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 في لوحة المفاتيح وستجد البرنامج يقوم بإظهار رمز الباركود المقابل له في النموذج

اختكم

زهره

تم تعديل هذه المشاركة بواسطة zahrah في 14 أكتوبر 2005 في 13:50

4 −1
#2

جزاك الله كل خير أستاذتي :)

▲ 1

علمني ولك أجري وأجر من سأعلمه وما سأعمله إن شاء الله

:)

#3

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

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

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

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

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

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

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

▲ -1

يا حيّ يا قيـوم ... برحمتك استغيث ... اصلح لي شأني كله و لا تكلني الى نفسي طرفة عين

#4

بارك الله فيك

رابط خط Code128 لا يعمل

▲ 1
#5

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

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

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

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

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

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

▲ -1
#6

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

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

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

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

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

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

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

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

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

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

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

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

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

▲ -1

يا حيّ يا قيـوم ... برحمتك استغيث ... اصلح لي شأني كله و لا تكلني الى نفسي طرفة عين

#7

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

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

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

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

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

▲ -1

يا حيّ يا قيـوم ... برحمتك استغيث ... اصلح لي شأني كله و لا تكلني الى نفسي طرفة عين

#8

السلام عليكم أخواني الكرام

أنبه حضراتكم أن شهر القرآن قارب على الإنتصاف و أذكر نفسي و إياكم بالرجوع إليه

و أرجو أن ندعو لبعض بظهر الغيب أن يوفقنا الله إلى الخير و إلى تعلم العلم النافع

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

و الله الموفق

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

▲ 1

يا حيّ يا قيـوم ... برحمتك استغيث ... اصلح لي شأني كله و لا تكلني الى نفسي طرفة عين

#9

اخي ابو وليد

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

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

الاخ

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

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

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

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

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

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

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

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

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

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

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

اختكم

زهره

▲ -1
#10

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

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

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

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

هل ممكن ذلك

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

▲ -1
#11

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

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

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

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

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

أليس كذلك

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

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

ابو رحمة

▲ -1

يا حيّ يا قيـوم ... برحمتك استغيث ... اصلح لي شأني كله و لا تكلني الى نفسي طرفة عين

#12

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

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
#13

بارك الله فيك ورزقك من واسع فضله

▲ -1
#14

السلام عليكم

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

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

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

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

ابو رحمة

▲ -1

يا حيّ يا قيـوم ... برحمتك استغيث ... اصلح لي شأني كله و لا تكلني الى نفسي طرفة عين

#15

جزاكم الله خيراً على هذا المجهود الرائع

ما هو كود ال VB المستخدم للبحث باسخدام الباركود ، بحيث اضع اسكنر الباركود على الصنف فيظهر على الشاشة

#16

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

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

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

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

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

تم تعديل هذه المشاركة بواسطة دبلوم غلبان في 16 أكتوبر 2005 في 16:29

▲ -1
#17

اخي الكريم

اذا اردت كود الـ 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 http://www.BizFonts.com/vba/ 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 http://www.BizFonts.com/vba/ 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:
' http://www.idautomation.com/code128faq.html#EAN128andUCC128
'
' 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

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

▲ -1
#18
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

اختكم

زهره

▲ -1
#19

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

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

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

تم تعديل هذه المشاركة بواسطة دبلوم غلبان في 19 أكتوبر 2005 في 00:31

▲ -1
#20
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 في لوحة المفاتيح وستجد البرنامج يقوم بإظهار رمز الباركود المقابل له في النموذج

اختكم

زهره

شكرا جزيلا

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

1▲ -1
#21

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

جزاكي الله خيرا على مشاركاتك المفيدة، لي سؤال، كيف يمكن الإستفادة من الأجهزة Handheld لعمل الباركود؟ وهل هناك أمثله علي البرامج التى تعمل عليها؟ وما فكرة عمل البرامج لكي تقوم بتزامن البيانات المقروءة بالبيانات الموجودة في قاعدة البيانات؟

#22

الاخت زهرة

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

كيف يمكن تسجيل اداة ال ocx الخاصة بالباركود من خلال ويندوز فيستا

#23

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

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

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

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

▲ -1
#24

Up

لا ادري ما مدى نجاح تجربه الموضوع باستخدام السكنر العادي (اي بدون استخدام قارئة البار كود) (h)

▲ 1

مع تحيات : عبدالرحمن نورالله
بيلار الدولية للتكنولوجيا لتصميم وأستضافة مواقع الأنترنت ، شركة مسجلة في المملكة الاردنية الهاشمية

أستضافة مواقع (Website Hosting) ابتداء من 35دينار اردني (50$) سنوي 962799247524+ أضغط هنا

logo.png

#25

الف شكررررررر أختي زهرة

▲ -1

مواضيع مشابهة