AW: Microsoft barcode control 15.0
18.10.2021 13:08:08
UweD
Hallo Tim
ich habe (auch aus dem WEB) eine VBA- Lösung für Code128
Eine einfache Zuweisung wie bei Code39 ist hier nicht möglich, da 2 Zeichen zu einem Wert verrechnet werden um den Code kürzer zu bekommen
Dazu ist ein Programm erforderlich.
Du brauchst dann zusätzlich nur noch eine "Code 128 Schriftart," die es kostenlos gibt. z.B.
https://www.zoll.de/DE/Fachthemen/Zoelle/ATLAS/ATLAS-Publikationen/Sonstiges/sonstiges_node.html
Versuch das mal..
'Funktion zum ermitteln der Prüfziffer für den Barcode Code128.
'Getestet mit Tabellendokumenten in OpenOffice 3 und MS-Office 2000.
'Bei Fehlern wird kein Wert zurückgegeben, sonst der errechnete Text.
'Nach der korrekten Integration des Makros in ein Tabellendokument
'kann das Makro z.B. mit der Formel =code128(A1) aufgerufen werden,
'wenn in der Zelle A1 der Ausgangstext steht.
'(C) 2009 - www.matsel.de - webmaster@matsel.de - Letzte Änderung 26.06.2009
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
Entweder in ein Modul in deiner Datei oder in die Personal.xl..
Im Tabellenblatt dann
- Formel z.B. B1: =code128(A1)
- Schriftart Code128 auswählen
- Schriftgröße z.b. 48
- Spaltenbreite um einiges breiter als der angezeigte Text wählen, da rechts und links Freizonen erforderlich sind
- Zelle zentriert formatieren
- Die Zelle ist dann wie eine normale Formel kopierbar.
LG UweD