kann man eingescannte EAN Nummern intern in Excel in der Spalte in für einen Handscanner lesbaren Barcode umwandeln?
Damit meine ich keine Schriftart, die die Zeichen umwandelt, da diese nicht lesbar sind für den Handscanner.
LG
Jule
Public Function Code128$(Text$)
Dim x%, y%, fehlzeichen%, checksumme&
Dim Zeichensatz As Variant
Zeichensatz = Array("ß", "!", Chr(34), "#", "$", "%", "&", "'", "(", ")", "*", "+", ",", "-", ".", "/", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ":", ";", "<", "=", ">", "?", "@", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "[", "\", "]", "^", "_", "`", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "{", "|", "}", "~", "´", "ä", "ö", "ü", "Ä", "Ö", "Ü", "µ", "À", "Á", "Â", "È")
Code128$ = ""
'Die Maximallänge des Textes wird auf 40 Zeichen begrenzt, um fehlerhafte Scans zu vermeiden.
If (Len(Text$) > 40) Then
x% = MsgBox("Der zu codierende Text ist " & Str(Len(Text$) - 40) & " Zeichen zu lang." & Chr(13) & "Um Fehler beim Scannen des Barcodes zu vermeiden, ist dieses Makro auf 40 Zeichen begrenzt.", 64, "Barcode-Generator (Code 128)")
Exit Function
End If
'Wenn kein Text zu codieren ist, dann Funktion beenden.
If (Len(Text$) = 0 Or Text$ = "0") Then
Exit Function
End If
'Testen, ob im Ausgangstext ein ß enthalten ist
If (InStr(Text$, "ß") <> 0) Then
x% = MsgBox("Das Zeichen ß kann nicht dargestellt werden.", 64, "Barcode-Generator (Code 128)")
Exit Function
End If
'Das Startzeichen hat den Wert 104
checksumme& = 104
'Leerzeichen durch ß ersetzen
Text$ = Replace(Text$, " ", "ß")
'Prüfziffer berechnen
For x% = 1 To Len(Text$)
fehlzeichen% = 1
For y% = 0 To 94
If (Mid$(Text$, x%, 1) = Zeichensatz(y%)) Then
fehlzeichen% = 0
checksumme& = checksumme& + (x% * y%)
Exit For
End If
Next y%
If fehlzeichen% = 1 Then
x% = MsgBox("Das Zeichen " & Mid$(Text$, x%, 1) & " kann nicht dargestellt werden.", 64, "Barcode-Generator (Code 128)")
Exit Function
End If
Next x%
'Rest ermitteln
checksumme& = checksumme& Mod 103
'Ergebnis = Startzeichen + Text + Prüfziffer + Stoppzeichen
Code128$ = "Á" & Text$ & Zeichensatz(checksumme&) & "È"
End Function
=Code128(A2)