Public Function EAN8$(barcode$)
 'Heiko Hommes
  '27.08.2008
  'barcode EAN8
  'Parameter: 8er EAN
  'Rückgabe:  Code, auf den man die Schriftart EAN13 legen kann
  
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  EAN8$ = ""
  
  'prüfziffer abschneiden
  If Len(barcode$) = 8 Then
    barcode$ = mid$(barcode$,1,7)
  End if
  
  'Länge 7 Zeichen prüfen'
  If Len(barcode$) = 7 Then
    'sind die zeichen auch korrekt
    For i% = 1 To 7
      If Asc(Mid$(barcode$, i%, 1)) < 48 Or Asc(Mid$(barcode$, i%, 1)) > 57 Then
        i% = 0
        Exit For
      End If
    Next
    If i% = 8 Then
      'Checksummenberechnung
      For i% = 7 To 1 Step -2
        checksum% = checksum% + Val(Mid$(barcode$, i%, 1))
      Next
      checksum% = checksum% * 3
      For i% = 6 To 1 Step -2
        checksum% = checksum% + Val(Mid$(barcode$, i%, 1))
      Next
      barcode$ = barcode$ & (10 - checksum% Mod 10) Mod 10
      'Die ersten 4 Zeichen kommen aus Tabelle A'
      CodeBarre$ = ":"   'Start Zeichen anfügen
      For i% = 1 To 4
         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(barcode$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "*"   'Trenner
      For i% = 5 To 8
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(barcode$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "+"   'Endzeichen setzen
      EAN8$ = CodeBarre$
    End If
  End If
End Function

Function hh_()
Dim co As String

co = ean8("1234567")
Sheets("Tabelle1").Cells(1, 1).Value = co

End Function