kemal turan
Altın Üye
- Katılım
- 10 Haziran 2011
- Mesajlar
- 1,527
- Excel Vers. ve Dili
- Excel 2010 32 bit
- Altın Üyelik Bitiş Tarihi
- 06-10-2032
Merhaba,
EAN13 fontunu indirdim.
ek resimde görüleceği üzere barcod fontunda neden farklı değer veriyor.
aşağıdaki kod ise modülde
EAN13 fontunu indirdim.
ek resimde görüleceği üzere barcod fontunda neden farklı değer veriyor.
aşağıdaki kod ise modülde
Kod:
Public Function ean13$(chaine$)
'Function by : http://grandzebu.net/
'Description : http://grandzebu.net/informatique/codbar-en/codbar.htm
'V 1.0
'Paramètres : une chaine de 12 chiffres
'Retour : * une chaine qui, affichée avec la police EAN13.TTF, donne le code barre
' * une chaine vide si paramètre fourni incorrect
Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
ean13$ = ""
'Vérifier qu'il y a 12 caractères
' EKLEME biolight - 2008 - info@mentes.com.tr
' SIFIRLA BAŞLAYAN AMERİKAN EAN13 BARKODLAR İÇİN EK
If Len(chaine$) < 12 Then
chaine$ = String((12 - Len(chaine$)), "0") & chaine$
End If
If Len(chaine$) = 12 Then
'Et que ce sont bien des chiffres
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
'Calcul de la clé de contrôle
For i% = 2 To 12 Step 2
checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
Next
checksum% = checksum% * 3
For i% = 1 To 11 Step 2
checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
Next
chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
'Le premier chiffre est pris tel quel, le deuxième vient de la table A
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$ & "*" 'Ajout séparateur central
For i% = 8 To 13
CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
Next
CodeBarre$ = CodeBarre$ & "+" 'Ajout de la marque de fin
ean13$ = CodeBarre$
End If
End If
End Function
Ekli dosyalar
-
367.6 KB Görüntüleme: 10