Sayın berdus,
Dim n, hsp1, hsp2, sonuc As Integer
bu şekilde ekledim,
ama sonuç olarak yukarıda yazdığım gibi 8 rakamını veriyor.?
EAN8, EAN13 ve EAN 128 Barkodlar hepsi aynı çalışmada...
dediğim gibi emin değilim ama @ozanakkaya hocamın yazdığı kod kontrol hanesini yani 13. basamağı hesaplama kodu olabilir
isterseniz 13 haneli bir kodun 12 hanesini girerek sonucun 13. basamağa eşit olup olmadığını deneyin
aşağıdaki bağlantıyı inceleyebilirsiniz
http://gs1.tobb.org.tr/kontrol_basamagi_...2677940735
isterseniz 13 haneli bir kodun 12 hanesini girerek sonucun 13. basamağa eşit olup olmadığını deneyin
aşağıdaki bağlantıyı inceleyebilirsiniz
http://gs1.tobb.org.tr/kontrol_basamagi_...2677940735
Verdiğim kod 13. basamağın hesaplama kodu.
Sayın hocalarım, bu kodu nasıl uygulayacağım konusunda hiç bir fikrim yok,
mehmet hocanın bean13 için düzenlediği yani 12 ye sabitlediği kodu,
normal olan 13 rakama uyarlanması benim işimi görecek,
lütfen aşağıdaki kod grubunu düzenleyip verirseniz çok sevinirim.
'
mehmet hocanın bean13 için düzenlediği yani 12 ye sabitlediği kodu,
normal olan 13 rakama uyarlanması benim işimi görecek,
lütfen aşağıdaki kod grubunu düzenleyip verirseniz çok sevinirim.
'
Kod:
''''''''''''''' AcessTr.neT '''''''''''''''''''''''''''
Option Compare Database
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Sub DownloadFileFromWeb()
Dim myFile As String
Dim Ret As Long
Dim strSavePath As String
Dim URL As String
URL = "http://www.accesstr.net/sitegenel/ean13.ttf"
strSavePath = Environ("TEMP") & "\GeciciBarkod\ean13.ttf"
Debug.Print strSavePath
Ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
If Ret = 0 Then
Exit Sub
Else
MsgBox "Dosya Yüklenemedi"
End If
End Sub
Public Function EAN13$(chaine$)
Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
EAN13$ = ""
If Len(chaine$) = 12 Then
For i% = 1 To 12
If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
i% = 0
Exit For
End If
Next
If i% = 13 Then
For i% = 12 To 1 Step -2
checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
Next
checksum% = checksum% * 3
For i% = 11 To 1 Step -2
checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
Next
chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
first% = Val(Left$(chaine$, 1))
For i% = 3 To 7
tableA = False
Select Case i%
Case 3
Select Case first%
Case 0 To 3
tableA = True
End Select
Case 4
Select Case first%
Case 0, 4, 7, 8
tableA = True
End Select
Case 5
Select Case first%
Case 0, 1, 4, 5, 9
tableA = True
End Select
Case 6
Select Case first%
Case 0, 2, 5, 6, 7
tableA = True
End Select
Case 7
Select Case first%
Case 0, 3, 6, 8, 9
tableA = True
End Select
End Select
If tableA Then
CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
Else
CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
End If
Next
CodeBarre$ = CodeBarre$ & "*"
For i% = 8 To 13
CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
Next
CodeBarre$ = CodeBarre$ & "+"
EAN13$ = CodeBarre$
End If
End If
End Function
Public Function DuzenleOnarYenile()
Dim scriptpath As String
Dim TimeOut As Integer
scriptpath = Application.CurrentProject.FullName & ".dbrestart.bat"
If Dir(scriptpath, vbNormal) <> "" Then
If DateAdd("s", TimeOut * 2, FileDateTime(scriptpath)) < Date Then
Kill scriptpath
Else
Application.Quit acQuitSaveAll
Exit Function
End If
End If
Dim S As String
S = S & "SETLOCAL ENABLEDELAYEDEXPANSION" & vbCrLf
S = S & "SET /a counter=0" & vbCrLf
S = S & ":CHECKLOCKFILE" & vbCrLf
S = S & "ping 0.0.0.255 -n 1 -w 100 > nul" & vbCrLf
S = S & "SET /a counter+=1" & vbCrLf
S = S & "IF ""!counter!""==""" & TimeOut & """ GOTO CLEANUP" & vbCrLf
S = S & "IF EXIST ""%~f2.%4"" GOTO CHECKLOCKFILE" & vbCrLf
S = S & """%~f1"" ""%~f2.%3"" /compact" & vbCrLf
S = S & "start "" "" ""%~f2.%3""" & vbCrLf
S = S & ":CLEANUP" & vbCrLf
S = S & "del %0"
Dim intFile As Integer
intFile = FreeFile()
Open scriptpath For Output As #intFile
Print #intFile, S
Close #intFile
Dim dbname As String, ext As String, lockext As String, accesspath As String
Dim idx As Integer
accesspath = SysCmd(acSysCmdAccessDir) & "msaccess.exe"
For idx = Len(CurrentProject.FullName) To 1 Step -1
If Mid(CurrentProject.FullName, idx, 1) = "." Then Exit For
Next idx
dbname = Left(CurrentProject.FullName, idx - 1)
ext = Mid(CurrentProject.FullName, idx + 1)
If Left(ext, 2) = "ac" Then
lockext = "laccdb"
Else
lockext = "ldb"
End If
S = """" & scriptpath & """ """ & accesspath & """ """ & dbname & """ " & ext & " " & lockext
Shell S, vbHide
Application.Quit acQuitSaveAll
End Function
Merhaba hocalarım,
If Len(chaine$) = 12 Then
bu satırı silince sorun kalmadı,
ilginiz için çok çok teşekkür ederim.
mehmet hoccanın bu satırı neden eklediğini bir türlü anlamadım,
siz biliyormusunuz?
If Len(chaine$) = 12 Then
bu satırı silince sorun kalmadı,
ilginiz için çok çok teşekkür ederim.
mehmet hoccanın bu satırı neden eklediğini bir türlü anlamadım,
siz biliyormusunuz?
Son Düzenleme: 20/08/2019, 12:23, Düzenleyen: ates2014.
Konuyu Okuyanlar: 5 Ziyaretçi
