Temat: Kod kreskowy EAN-13 w excelu

=ean13("590823229462";1)

Function ean13(dokod As String, Optional hr As Integer) As String

On Error Resume Next

Dim kod(100), arr() As Variant

Dim a As Long, i As Long, j As Long, k As Long

Dim ak As Integer, szer As Integer

Dim shp As Shape, rng As Range

Set rng = Application.Caller

Dim parzystosc, lewn, lewp, praw, drugi, startsentinel, wytworca, srodek

Dim wsp, iloczyn, cyfrakontr, zerojed, prawe, endsentinel, kr



prawe = ""

endsentinel = "111"

szer = 2

parzystosc = Array("NNNNNN", "NNPNPP", "NNPPNP", "NNPPPN", "NPNNPP", "NPPNNP", "NPPPNN", "NPNPNP", "NPNPPN", "NPPNPN")

lewn = Array("3211", "2221", "2122", "1411", "1132", "1231", "1114", "1312", "1213", "3112")

lewp = Array("1123", "1222", "2212", "1141", "2311", "1321", "4111", "2131", "3121", "2113")

praw = Array("3211", "2221", "2122", "1411", "1132", "1231", "1114", "1312", "1213", "3112")



For i = 1 To 12

    wsp = 1

    If i Mod 2 = 0 Then wsp = 3

    iloczyn = Val(Mid(dokod, i, 1)) * wsp

    cyfrakontr = cyfrakontr + iloczyn

Next i

cyfrakontr = (Application.WorksheetFunction.RoundUp(cyfrakontr / 10, 0) * 10) - cyfrakontr

dokod = dokod & cyfrakontr

drugi = parzystosc(Val(Left(dokod, 1)))

startsentinel = "111"

wytworca = ""

srodek = "11111"



For i = 2 To 7

    If Mid(drugi, i - 1, 1) = "N" Then

        wytworca = wytworca & lewn(Val(Mid(dokod, i, 1)))

    Else

        wytworca = wytworca & lewp(Val(Mid(dokod, i, 1)))

    End If

Next i



zerojed = startsentinel & wytworca & srodek

prawe = ""

endsentinel = "111"



For i = 8 To 13

    prawe = prawe & praw(Val(Mid(dokod, i, 1)))

Next i



zerojed = zerojed & prawe & endsentinel





kod(0) = 10

For a = 1 To Len(zerojed)

    kod(a) = Mid(zerojed, a, 1)

Next a

kod(a + 1) = 10



ak = 10 * szer



ActiveSheet.Shapes.Range("kod_" & rng.Address).Delete

With rng.Worksheet.Shapes

    For i = 1 To a + 1 - 1 Step 2

        If i <= 3 Or (i > 27 And i <= 32) Or i > 56 Then

            kr = 0

        Else

            kr = 15

        End If

        If rng.Height < 25 Then kr = 0

        Set shp = .AddShape(msoShapeRectangle, rng.Left + ak, rng.Top, kod(i) * szer, rng.Height - kr)

        ak = ak + (kod(i) * szer) + (kod(i + 1) * szer)

        On Error Resume Next

        j = 0: j = UBound(arr) + 1

        On Error GoTo 0

        ReDim Preserve arr(j)

        arr(j) = shp.Name

    Next i

    With rng.Worksheet.Shapes.Range(arr)

        .Group

        .Line.Visible = False

        .Fill.ForeColor.RGB = RGB(0, 0, 0)

        .Name = "kod_" & rng.Address

    End With

End With



ean13 = ""

If hr = 1 Then

    ean13 = "   " & Left(dokod, 1) & "          "

    For k = 2 To 8

        ean13 = ean13 & Mid(dokod, k, 1) & " "

    Next k

    ean13 = ean13 & "              "

    For k = 9 To 13

        ean13 = ean13 & Mid(dokod, k, 1) & " "

    Next k

End If

End Function

29.10.2010, 15:51

Link do wypowiedzi | Cytuj

Temat: Kod kreskowy EAN-13 w excelu

Z drugiej strony nie jestem pewien czy prawo wymaga żeby na produkcie kod EAN był zapisany kodem kreskowym

ale zarządzanie towarem poprzez spisywanie ręczne było by co najmniej kłopotliwe.

Więc na jakiej zasadzie oceniasz że wygenerowany kod jest zły?

ale obiły mi się o uszy prostsze rozwiązania na obliczanie liczby kontrolnej.

For i = 1 To 12

    wsp = 1

    If i Mod 2 = 0 Then wsp = 3

    iloczyn = Val(Mid(dokod, i, 1)) * wsp

    cyfrakontr = cyfrakontr + iloczyn

Next i

Z tego co pamiętam lepiej dla bezpieczeństwa dodawać przed i po kodzie "*", czyli "*5908232294622*".

przeciętny skaner mi to odczyta i wrzuci do komputera jak tekst wpisany z klawiatury

29.10.2010, 22:25

Link do wypowiedzi | Cytuj