Barcode 39 Prüfziffer berechnen

Marc · 2006-08-24T17:20:49+00:00

Hallo zusammen, ich habe da ein kleines Problem. Ich möchte gern Belege erzeugen, welche einen Barcode tragen, um sie später in ein optisches Archiv einscannen zu können, durch die im Barcode verschlüsselten Informationen läßt sich der Beleg später wieder finden. Ich habe also einen Truetype Font benutzt, der den entsprechenden Code darstellt. Leider reicht das für unser System noch nicht aus. Es wird noch eine Prüfziffer benötigt. Wie sich diese Prüfziffer errechnen läßt, das ist unter folgendem Link beschrieben und stimmt auch mit dem von uns verwendeten System überein. Ich habe es manuell nachgeprüft. http://www.strichcodeservice.at/code39.htm#Prüfzeichenberechnung Nach dieser Methode erhält das Wort Excel die Prüfziffer 8. Soweit so gut. Ich habe nun innerhalb des Beleges die Informationen aus drei Zellen genommen, einmal eine Mischung aus Buchstaben und Zahlen, einmal ein Datum, von dem ich jedoch nur das Jahr anzeigen lasse und einmal eine Ziffernfolge, und habe sie durch die Funktion verketten in eine Zelle gebracht. Die Formel sieht so aus: =WENN(ODER(D8="";I8="");"";VERKETTEN(C5;JAHR(D8);I8)) Das alles in der Schriftart für Barcodes dargestellt ergibt den richtigen Balkencode. Mir fehlt aber noch eine Methode die in der Zelle, durch verketten, angezeigten Informationen automatisch auslesen und daraus eine Prüfziffer oder ein Prüfzeichen errechnen zu lassen, um dies anschließend in die Zeichenfolge zu integrieren. Hierbei stehe ich vor einem etwas größeren Problem. Hat jemand eine Idee, wie man das per Formel oder von mir aus auch per VBA lösen kann? Ich wäre euch für Antworten wirklich sehr dankbar!!! Viele Grüße, Marc Richter

Hallo Marc,
Hallo Peter,
Ich habe Peters Routine etwas umgeschrieben. Seine Idee ist grundsätzlich richtig!
Grund: Sie gibt einen falschen Wert raus, wenn ein "illegales" Zeichen im InpuntString ist
(z.B. Kleinbuchstaben, Umlaute oder nicht erlaubte Sonderzeichen).
Die Funktion so geschrieben, gibt nicht nur die Prüfziffer raus, sondern den ganzen String plus die PZ, so das die entsprechende Zelle direkt in mit dem entsprechenden Font formatiert werden kann. Also z.B. So
=Code39_PZ(WENN(ODER(D8="";I8="");"";VERKETTEN(C5;JAHR(D8);I8)))
Gruss Hansueli


Option Explicit
Public Function Code39_PZ(strEingabe As String) As String
Dim arrZeichen   As Variant
Dim intWert      As Integer
Dim intLaenge    As Integer
Dim intQuerSu    As Integer
Dim intPZ        As Integer
Dim strZeichen   As String
Dim bfound As Boolean
arrZeichen = Array("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", "-", ".", " ", "$", _
"/", "+", "%")
For intLaenge = 1 To Len(strEingabe)
strZeichen = UCase(Mid(strEingabe, intLaenge, 1))
bfound = False
For intWert = 0 To 41
If arrZeichen(intWert) = strZeichen Then
intQuerSu = intQuerSu + (intWert)
bfound = True
Exit For
End If
Next intWert
If Not (bfound) Then
Code39_PZ = "Falsche Zeichen <" & strZeichen & "> für Code 39"
Exit Function
End If
Next intLaenge
intPZ = intQuerSu Mod 43
Code39_PZ = UCase(strEingabe) & arrZeichen(intPZ)
End Function

Hallo UweD,
danke für den Hinweis.
Dann würde meine


Function (mit Dokumentation) und Test-Makro so aussehen:
'   Bei alphanumerischen Inhalten des Code39 Symbols wird das Prüfzeichen
'   nach Module 43 berechnet.
'   Nur numerische Inhalte können nach Modulo 10 berechnet werden.
'   1. Jedem Zeichen des Code39 wird ein Referenzwert zugeordnet.
'   2. Diese Referenzwerte werden addiert und durch 43 dividiert.
'   3. Dem Divisionsrest wird ein Zeichen aus dem Zeichenvorrat des
'      Code39 zugeordnet.
'   Die Funktion so geschrieben, gibt nicht nur die Prüfziffer raus, sondern
'   den ganzen String plus der PZ, so dass die entsprechende Zelle direkt mit
'   dem entsprechenden Font formatiert werden kann. Also z.B. So
'   =Code39_PZ(WENN(ODER(D8="";I8="");"";VERKETTEN(C5;JAHR(D8);I8)))
'   Bei code39 muß ja vor den Dateninhalt und dahinter noch ein Startzeichen
'   (*) gesetzt werden.
'   Also "*" & deine Daten mit Prüfziffer & "*"
Public 

Function Code39_PZ(strEingabe As String) As String
Dim arrZeichen   As Variant   ' die Zeichen des CODE39
Dim intWert      As Integer   ' der Referenzwert - auch Index des Arrays
Dim intLaenge    As Integer   ' Länge des eingegebenen CODE39 - ohne PZ
Dim intQuerSu    As Integer   ' die Quersumme der Referenzwerte
Dim intPZ        As Integer   ' die Prüfziffer - als numerischer Index
Dim strZeichen   As String    ' das einzelne Zeichen des CODE39
Dim bolGefund    As Boolean   ' Schalter für gefunden - True/False
'  die zulässigen Zeichen des CODE39 - als Array vorgegeben
arrZeichen = Array("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", "-", ".", " ", "$", _
"/", "+", "%")
For intLaenge = 1 To Len(strEingabe) ' in Länge der Eingabe diese abarbeiten
strZeichen = Mid(strEingabe, intLaenge, 1)  ' Zeichen für Zeichen
bolGefund = False                 ' Schalter auf NICHT gefunden setzen
For intWert = 0 To 41             ' alle 42 gültigen Zeichen durchsuchen
If arrZeichen(intWert) = strZeichen Then ' Zeichen gefunden?
intQuerSu = intQuerSu + (intWert)     ' Quersumme addieren
bolGefund = True                      ' Schalter auf gefunden setzen
Exit For                              ' For/Next verlassen
End If
Next intWert                      ' nächstes gültiges Zeichen des CODE39
If Not (bolGefund) Then           ' wurde das Zeichen NICHT gefunden?
Code39_PZ = "Ein falsches Zeichen <" & strZeichen & "> für Code 39"
Exit 

Function                  ' die 

Function mit Fehlerhinweis verlassen
End If
Next intLaenge                       ' nächstes Zeichen der Eingabe
intPZ = intQuerSu Mod 43             ' Rest der Division durch 43 ermitteln
'Code39_PZ = strEingabe & arrZeichen(intPZ)     ' Eingabe + Prüfzeichen ausgeben
Code39_PZ = "*" & strEingabe & arrZeichen(intPZ) & "*"
End Function


'

'    Test der obigen 

Function - aus der Eingabe CODE39 soll als Prüfzeichen
'    ein W herauskommen - also komplett CODE39W
'    Zeichen        C   O   D   E   3   9
'    Referenzwert  12  24  13  14   3   9
'    Quersumme     75
'    Modulo 43     75 Mod 43 = 32 (75/43 = 1 Rest 32)
'    Prüfzeichen   auf Position 32 = W (das Zählen beginnt bei Position Null)

Sub Test()
MsgBox Code39_PZ("CODE39"), _
64, "   Hinweis für " & Application.UserName
End Sub


Viele Grüße Peter

Eine kurze Nachricht, ob es läuft, wäre nett - danke.

Forumthread: Barcode 39 Prüfziffer berechnen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial