معادلة باركود

[nabilfaraj]

الاخوة الاعزاء 

ارجو منكم خدمة ألا وهي مساعدي في انشاء معادلة لتوليد البارمود تتكون من  4 خانات او ان يكون لي حرية اختيار عدد الخانات على غرار التالي حيث ان المعادلة التالية لا تقبل اقل من 13 خانة ولكم الشكر ..

Public Function CodeEan13$(chaine$)

Application.Volatile

   Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean

  CodeEan13$ = ""

    If Len(chaine$) = 12 Then

       For i% = 1 To 12

      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then

        i% = 0

        Exit For

      End If

    Next

    If i% = 13 Then

         For i% = 12 To 1 Step -2

        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))

      Next

      checksum% = checksum% * 3

      For i% = 11 To 1 Step -2

        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))

      Next

      chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10

            CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))

      first% = Val(Left$(chaine$, 1))

      For i% = 3 To 7

        tableA = False

         Select Case i%

         Case 3

           Select Case first%

           Case 0 To 3

             tableA = True

           End Select

         Case 4

           Select Case first%

           Case 0, 4, 7, 8

             tableA = True

           End Select

         Case 5

           Select Case first%

           Case 0, 1, 4, 5, 9

             tableA = True

           End Select

         Case 6

           Select Case first%

           Case 0, 2, 5, 6, 7

             tableA = True

           End Select

         Case 7

           Select Case first%

           Case 0, 3, 6, 8, 9

             tableA = True

           End Select

         End Select

       If tableA Then

         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))

       Else

         CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))

       End If

     Next

      CodeBarre$ = CodeBarre$ & "*"

      For i% = 8 To 13

        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))

      Next

      CodeBarre$ = CodeBarre$ & "+"

      CodeEan13$ = CodeBarre$

    End If

  End If

End Function

Public Function AddOn$(chaine$)

   Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean

  AddOn$ = ""

   If Len(chaine$) = 2 Or Len(chaine$) = 5 Then

      For i% = 1 To Len(chaine$)

      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then

        Exit Function

      End If

    Next

    If Len(chaine$) = 2 Then

      checksum% = 10 + chaine$ Mod 4

      For i% = 1 To 5 Step 2

        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))

      Next

      checksum% = (checksum% * 3 + Val(Mid$(chaine$, 2, 1)) * 9 + Val(Mid$(chaine$, 4, 1)) * 9) Mod 10

    End If

    AddOn$ = "["

    For i% = 1 To Len(chaine$)

      tableA = False

      Select Case i%

      Case 1

        Select Case checksum%

        Case 4 To 9, 10, 11

          tableA = True

        End Select

      Case 2

        Select Case checksum%

        Case 1, 2, 3, 5, 6, 9, 10, 12

          tableA = True

        End Select

      Case 3

        Select Case checksum%

        Case 0, 2, 3, 6, 7, 8

          tableA = True

        End Select

      Case 4

        Select Case checksum%

        Case 0, 1, 3, 4, 8, 9

          tableA = True

        End Select

      Case 5

        Select Case checksum%

        Case 0, 1, 2, 4, 5, 7

          tableA = True

        End Select

      End Select

      If tableA Then

        AddOn$ = AddOn$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))

      Else

        AddOn$ = AddOn$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))

      End If

      If (Len(chaine$) = 2 And i% = 1) Or (Len(chaine$) = 5 And i% < 5) Then AddOn$ = AddOn$ & Chr$(92)

    Next

  End If

End Function

 

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

الموضوع غير واضح

يرجى إرفاق ملف للتوضيح