الاخوة الاعزاء
ارجو منكم خدمة ألا وهي مساعدي في انشاء معادلة لتوليد البارمود تتكون من 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
