EAN8, EAN13 ve EAN 128 Barkodlar hepsi aynı çalışmada...

1 2 3 4 5 6 7 8 9
12/07/2019, 14:06

cozum

(06/07/2019, 16:08)mehmetdemiral yazdı: Teşekkürler.
Code39 VBA



Function Barcode_39(Ctrl As Control, rpt As Report)
    On Error GoTo ErrorTrap_BarCode39

    Dim Nbar As Single, Wbar As Single, Qbar As Single, Nextbar As Single
    Dim CountX As Single, CountY As Single, CountR As Single
    Dim Parts As Single, Pix As Single, Color As Long, BarCodePlus As Variant
    Dim Stripes As String, BarType As String, BarCode As String
    Dim Mx As Single, my As Single, Sx As Single, Sy As Single
    Const White = 16777215: Const Black = 0
    Const Nratio = 20, Wratio = 55, Qratio = 35

    'Get control size and location properties.
    Sx = Ctrl.Left: Sy = Ctrl.Top: Mx = Ctrl.Width: my = Ctrl.Height

    'Set handle on control.
    BarCode = Ctrl

    'Calculate actual and relative pixels values.
    Parts = (Len(BarCode) + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))
    Pix = (Mx / Parts):
    Nbar = (20 * Pix): Wbar = (55 * Pix): Qbar = (35 * Pix)

    'Initialize bar index and color.
    Nextbar = Sx
    Color = White

    'Pad each end of string with start/stop characters.
    BarCodePlus = "*" & UCase(BarCode) & "*"

    'Walk through each character of the barcode contents.
    For CountX = 1 To Len(BarCodePlus)
        'Get Barcode 1/0 string for indexed character.
        Stripes = MD_BC39(Mid$(BarCodePlus, CountX, 1))
        For CountY = 1 To 9
            'For each 1/0, draw a wide/narrow bar.
            BarType = Mid$(Stripes, CountY, 1)

            'Toggle the color (black/white).
            If Color = White Then Color = Black Else Color = White
            Select Case BarType
                Case "1"
                    'Draw a wide bar.
                    rpt.Line (Nextbar, Sy)-Step(Wbar, my), Color, BF
                    Nextbar = Nextbar + Wbar
                Case "0"
                    'Draw a narrow bar.
                    rpt.Line (Nextbar, Sy)-Step(Nbar, my), Color, BF
                    Nextbar = Nextbar + Nbar
            End Select
        Next CountY

        'Toggle the color (black/white).
        If Color = White Then Color = Black Else Color = White

        'Draw intermediate "quiet" bar.
        rpt.Line (Nextbar, Sy)-Step(Qbar, my), Color, BF
        Nextbar = Nextbar + Qbar
    Next CountX

Exit_BarCode39:
    Exit Function

ErrorTrap_BarCode39:
    Resume Exit_BarCode39
End Function

Function MD_BC39(CharCode As String) As String
    On Error GoTo ErrorTrap_BC39

    ReDim BC39(90)

    BC39(32) = "011000100" ' space
    BC39(36) = "010101000" ' $
    BC39(37) = "000101010" ' %
    BC39(42) = "010010100" ' * Start/Stop
    BC39(43) = "010001010" ' +
    BC39(45) = "010000101" ' |
    BC39(46) = "110000100" ' .
    BC39(47) = "010100010" ' /
    BC39(48) = "000110100" ' 0
    BC39(49) = "100100001" ' 1
    BC39(50) = "001100001" ' 2
    BC39(51) = "101100000" ' 3
    BC39(52) = "000110001" ' 4
    BC39(53) = "100110000" ' 5
    BC39(54) = "001110000" ' 6
    BC39(55) = "000100101" ' 7
    BC39(56) = "100100100" ' 8
    BC39(57) = "001100100" ' 9
    BC39(65) = "100001001" ' A
    BC39(66) = "001001001" ' B
    BC39(67) = "101001000" ' C
    BC39(68) = "000011001" ' D
    BC39(69) = "100011000" ' E
    BC39(70) = "001011000" ' F
    BC39(71) = "000001101" ' G
    BC39(72) = "100001100" ' H
    BC39(73) = "001001100" ' I
    BC39(74) = "000011100" ' J
    BC39(75) = "100000011" ' K
    BC39(76) = "001000011" ' L
    BC39(77) = "101000010" ' M
    BC39(78) = "000010011" ' N
    BC39(79) = "100010010" ' O
    BC39(80) = "001010010" ' P
    BC39(81) = "000000111" ' Q
    BC39(82) = "100000110" ' R
    BC39(83) = "001000110" ' S
    BC39(84) = "000010110" ' T
    BC39(85) = "110000001" ' U
    BC39(86) = "011000001" ' V
    BC39(87) = "111000000" ' W
    BC39(88) = "010010001" ' X
    BC39(89) = "110010000" ' Y
    BC39(90) = "011010000" ' Z

    MD_BC39 = BC39(Asc(CharCode))

Exit_BC39:
    Exit Function

ErrorTrap_BC39:
    MD_BC39 = ""

    Resume Exit_BC39
End Function



'Kullanımı
'Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
'Dim Result As Boolean
''Result = SetBarData(BarCode, Me) Barcode_128
'Result = Barcode_39(Me.BarCode, Me)
''Result = Barcode_39(Me.Code, Me)
'End Sub
20/08/2019, 09:34

ates2014

Merhabalar mehmet hocam,
Bean13 Barkod numaralarını 12 karektere neden sınırlandırdınız,
normal barkodlar 13 karekter, hatta koli barkodları daha uzun,
barkodu okutarak kaydediyorum, raporda çıktı almak istediğimde barkod görünmüyor,
ta ki 1 rakamı silince görünür oldu, birsürü uğraştım.
Mümkünse sayı sınırını kaldırabilirmisiniz veya 13' yükseltirseniz çok sevinirim,
yoksa bir sürü değişiklik yapmak zorunda kalacağım.
Çok teşekkür ederim...
20/08/2019, 09:57

ozanakkaya

Sayın @ates2014, barkod için kullanılan veri 12 karakterden oluşur. Barkodun 13. basamağı kontrol basamağıdır ve ilk 12 hanenin kombinasyonu ile oluşturulur.

Kod:
Function BarkodHesapla(barkodid)
Dim B(1 To 12) As Integer
    For N = 1 To 12
        B(N) = Mid(barkodid, N, 1)
    Next
   hsp1 = B(2) + B(4) + B(6) + B(8) + B(10) + B(12)
   hsp2 = B(1) + B(3) + B(5) + B(7) + B(9) + B(11)
   
    sonuc = 10 - ((3 * hsp1) + hsp2) Mod 10
    BarkodHesapla = sonuc
End Function
20/08/2019, 10:33

ates2014

Merhaba ozan hocam,
For N = 1 To 12
bu satır hata veriyor N harfi sarı renkli oluyor.?
20/08/2019, 10:40

ates2014

Selam ozan hocam,
bu kod ne için anlayamadım,
barkod oluşturması için uyguladım 532677940735 bu numaralı barkodu 8 olarak gösterdi.?
20/08/2019, 10:43

berduş

Dim B(1 To 12) As Integer satırının altına
dim N as integer
satırını ekleyerek dener misiniz?
emin değilim ama bu kod 13. haneyi yani kontrol basamağını hesaplama kodu olabilir
1 2 3 4 5 6 7 8 9