Re: Ean8, Ean13 Ve Ean 128 Barkodlar Hepsi Aynı Çalışmada... - cozum - 12/07/2019
(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
Cvp: EAN8, EAN13 ve EAN 128 Barkodlar hepsi aynı çalışmada... - ates2014 - 20/08/2019
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...
Cvp: EAN8, EAN13 ve EAN 128 Barkodlar hepsi aynı çalışmada... - ozanakkaya - 20/08/2019
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
Cvp: EAN8, EAN13 ve EAN 128 Barkodlar hepsi aynı çalışmada... - ates2014 - 20/08/2019
Merhaba ozan hocam,
For N = 1 To 12
bu satır hata veriyor N harfi sarı renkli oluyor.?
Cvp: EAN8, EAN13 ve EAN 128 Barkodlar hepsi aynı çalışmada... - ates2014 - 20/08/2019
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.?
Cvp: EAN8, EAN13 ve EAN 128 Barkodlar hepsi aynı çalışmada... - berduş - 20/08/2019
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
|