EXCEL 2010 BARCODE FONT PROBLEMİ.

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

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
ek dosyada ki fontu yabancı bir siteden indirip C/Windows/font dosyasına yapıştırdım.
sorunum çözüldü.
Teşekkürler.
 

Ekli dosyalar

Üst