Barcode Prüfziffer errechenen

[Bernie110]

Hallo Zusammen,

die Berechnung der Prüfziffer ist doch nicht so einfach wie ich mir das vorgestellt habe.

Der Barcde muss wiefolgt zerlegt werden :

Stelle ---------> 1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20
BarCode------> 0   0   3   4   0   3   6   3   3   9    7    2    6    0    0    0    0    0    0
Multiplikaor --> 3   1   3   1   3   1   3  1    3   1    3    1    3    1    3    1    3     1   3
Ergebnis------> 0   0   9   4   0   3   18 3   9   9    21  2    9    0    0    0    0     0   0        ----> Summe = 96


Summe = 96
um diesen Wert nun auf 10 aufzurunden fehlen 4  ... so ist die Prüfziffer 4


Die Prüfziffer errechnet sich nach folgendem Verfahren. Zunächst werden die Barcodeziffern abwechselnd von rechs nach links ( also von hinten nach vorne ) mit dem Faktor ( Multiplikator ) 3 oder 1 multipliziert und die Ergebnisse addiert.

Ist die letzte Stelle eine 0, dann ist die Prüfziffer auch eine 0
sonst ist die Prüfziffer die Differenz aus 10 und der letzten Stelle.


So nun müsste ich den BarCode in einzelne Stellen zerlegen...
Wie ? bzw wie würdet Ihr das machen.

( keine Ahnung wer sich diesen Schwachsinn ausgedacht hat.. wird schon seinen Grund dafür geben  )

Danke für eure Anworten.

Lg Bernie

[DF6GL]

Hallo,

bevor wir das Rad neu erfinden, google mal nach


Barcode Prüfziffer Berechnung VB

Da gibt es viele Beispiele für die Berechnung  nach unterschiedlichen Methoden und Normen, je nach Barcode-Typ.

[Bernie110]

Ja hab ich schon..

das hab ich gefunden.

Public Function Pruefziffer(strEANOhne) As String

    Dim intSummeEinfach As Integer

    Dim intSummeDreifach As Integer

    Dim i As Integer

    If Not Len(strEANOhne) = 12 Then

        MsgBox "Die zu prüfende Ziffernfolge muss zwölf Ziffern enthalten."

        Exit Function

    End If

    For i = 1 To 6

        intSummeEinfach = intSummeEinfach + Mid(strEANOhne, i * 2 - 1, 1)

        intSummeDreifach = intSummeDreifach + 3 * Mid(strEANOhne, i * 2, 1)

    Next i

    Pruefziffer = (10 - (intSummeEinfach + intSummeDreifach) Mod 10) Mod 10

End Function

Check ich aber nicht..
ist es das was ich suche ? 
Kann leider momentan nicht testen.
Gruss
Benie

[DF6GL]

Hallo,

nein, vermutlich nicht , Dein Code ist länger als 12 Zeichen..


hier mal ein angepasstes IN-Beispiel für den Code mit 20 Stellen:

Code [Auswählen] Erweitern

Public Function BCPZ(BC)
Dim I As Long, Sum As Long, Fak As Long
BCPZ = Null
If IsNull(BC) Then Exit Function
BCPZ = False
If Len(BC) <> 20 Then Exit Function
Sum = 0
Fak = 1
For I = Len(BC) To 1 Step -1
Sum = Sum + (Asc(Mid(BC, I, 1)) - Asc("0")) * Fak
If Fak = 3 Then
Fak = 1
Else
Fak = 3
End If
Next I
BCPZ = (10 - Sum Mod 10) Mod 10
End Function



Dein Berechnungsbeispiel benutzt 20 Stellen Barcodezeichen, aber nur 19 Stellen Gewichtungen...

[Bernie110]

Hallo Franz

irgendiwe übernimmt er nicht die Prüfziffer .

Mein BarCode sieht jetzt so aus
Barcode
*0034036339726000016Falsch*


Das ist jetzt mein Code und ich denke es liegt an diesem hier rs2!BarcodeNr = fktGenBarcode(lngSpedNr, rs2!BC_LfdNr)
Weiss aber nicht wie ich das beheben kann.
Kannst du bitte nochmals drüber sehen ?
Danke
Lg Bernie

Private Sub BT_Label_Click()
Dim lngStartNr As Long, rs1 As DAO.Recordset, rs2 As DAO.Recordset, lngLfNr As Long, db As Database

lngSendungsNr = Me.LfdNr   'diese Var. als Argument ausführen

Set db = CurrentDb

Set rs1 = db.OpenRecordset("Select LfdNr, Colli_Anzahl, Art_Code, Art, Art_Bez, Länge_cm, Breite_cm, Höhe_cm, kg, Einzel_Gewicht_Kg From ERFASSUNG_Colli where  DTNr =" & lngSendungsNr, dbOpenSnapshot)

Set rs2 = db.OpenRecordset("Select * from STAMM_BARCODENr ", dbOpenDynaset)


Do Until rs1.EOF


For I = 1 To rs1!Colli_Anzahl

rs2.AddNew
rs2!BC_LfdNr = Nz(DMax("BC_LfdNr", "STAMM_BARCODENr"), 0) + 1
rs2!SendungsNr = Me.LfdNr
rs2!PackstückNr = rs1!LfdNr

rs2!Colli = 1
rs2!Art_Code = rs1!Art_Code
rs2!Art = rs1!Art
rs2!Art_Bez = rs1!Art_Bez
rs2!Länge_Cm = rs1!Länge_Cm
rs2!Breite_Cm = rs1!Breite_Cm
rs2!Höhe_Cm = rs1!Höhe_Cm

If rs1!Einzel_Gewicht_Kg > 0 Then
rs2!Kg = rs1!Einzel_Gewicht_Kg
Else
rs2!Kg = rs1!Kg
End If


rs2!BarcodeNr = fktGenBarcode(lngSpedNr, rs2!BC_LfdNr)
rs2.Update

Next

rs1.MoveNext
Loop


rs2.Close: Set rs2 = Nothing
rs1.Close: Set rs1 = Nothing
Set db = Nothing

Me.QYR_BARCODE_GENERATOR.Requery

RunCommand acCmdSaveRecord
'DoCmd.OpenForm "DT_ERFASSUNG_MASSE_LABEL", , , "LfdNr=" & Me!LfdNr, , acDialog

End Sub
Public Function fktGenBarcode(SpedNr As Long, BC_LfdNr As Long) As String

Dim strBC As String, PZ As String, lngStartNr As Long
lngStartNr = 702000000


strBC = "003" & Format(SpedNr, "4036339") & Format(StartNr + BC_LfdNr, "000000000")   'vermutlich sich die Gänsefüße und Minus-Zeichen nicht Bestandteil des BC
fktGenBarcode = "*" & strBC & fktPZ(strBC) & "*"
End Function


Public Function fktPZ(BC As String) As String
'  Hier die Modulo 10 Berechnung

Dim I As Long, Sum As Long, Fak As Long
fktPZ = 0
If IsNull(BC) Then Exit Function
fktPZ = False
If Len(BC) <> 20 Then Exit Function
Sum = 0
Fak = 1
For I = Len(BC) To 1 Step -1
Sum = Sum + (Asc(Mid(BC, I, 1)) - Asc("0")) * Fak
If Fak = 3 Then
Fak = 1
Else
Fak = 3
End If
Next I
fktPZ = (10 - Sum Mod 10) Mod 10


'fktPZ = "1"    'als Test

End Function

[DF6GL]

Hallo,

Dein BC-String ist 19 Zeichen lang, in der Funktion wird aber auf 20 Zeichen getestet.. Änder das in "19" und "Fak = 1"  in "Fak = 3"

[Bernie110]

Super, danke,

scheint zu funktionieren.

Vielen Dank. LG Bernie