ean13字体生成条形码扫描枪不识别

Public Function getEAN13CODE(strCode As String) As String
    Dim str As String
    Dim i As Integer, j As Integer, k As Integer, i_tmp As Integer
    'str = "+"'Left(strCode, 1)
    k = CInt(Left(strCode, 1))
    str = ChrW(AscW("0") + k)
    i = 2
    While i <= Len(strCode)
        j = CInt(Mid(strCode, i, 1))
        Select Case i
        Case 2
            str = str + ChrW(65 + j)
        Case 3
            Select Case k
            Case 0 To 3
                i_tmp = 65
            Case Else
                i_tmp = 75
            End Select
            str = str + ChrW(i_tmp + j)
        Case 4
            Select Case k
            Case 0, 4, 7, 8
                i_tmp = 65
            Case Else
                i_tmp = 75
            End Select
            str = str + ChrW(i_tmp + j)
        Case 5
            Select Case k
            Case 0, 1, 4, 5, 9
                i_tmp = 65
            Case Else
                i_tmp = 75
            End Select
            str = str + ChrW(i_tmp + j)
        Case 6
            Select Case k
            Case 0, 2, 5, 6, 7
                i_tmp = 65
            Case Else
                i_tmp = 75
            End Select
            str = str + ChrW(i_tmp + j)
        Case 7
            Select Case k
            Case 0, 3, 6, 8, 9
                i_tmp = 65
            Case Else
                i_tmp = 75
            End Select
            str = str + ChrW(i_tmp + j) + ChrW(42) '"*"
        Case Else
            str = str + ChrW(97 + j)
        End Select
        i = i + 1
    Wend
    getEAN13CODE = str + ChrW(43) '"+"
End Function

6 个解决方案

#1

会不会是有宽度和色深等区别，还是你的算法错了？

#2

一般情况下直接用一个条码控件，OFFICE自带的，就能实现读取打印之类了

#3

建议研究一下条码扫描枪的说明书

#4

excel2003中用过barcodectrl控件，但程序调用打印时经常出现数值未更行现象，更改条码长、宽后问题依旧所以弃用。

#5

下载了IDAutomation控件，拷贝代码后发现我原来下载的EAN13字体有问题。各位老大谁有好用的EAN13字体发兄弟一份，万分感谢。[e-mail]

#6

问题已解决。在网上搜了一个eanbwrp36tt.ttf字体试了一下效果还不错。下边附上代码供大家参考
Function getEan13Code(strcode As String) As String
    Dim tmpRuleStr As String, tmpHandleStr As String
    Dim tmpRule, tmpHandle
    Dim tmpStr As String, tmpStr2 As String
    Dim i, j
    
    If Len(strcode) <> 13 Then
        getEan13Code = ""
        Exit Function
    End If
    If Not IsNumeric(strcode) Then
        getEan13Code = ""
        Exit Function
    End If
    tmpRuleStr = "AAAAAA,AABABB,AABBAB,AABBBA,ABAABB,ABBAAB,ABBBAA,ABABAB,ABABBA,ABBABA"
    tmpHandleStr = "# $ % & ' ( ) * + ,"
    tmpRule = Split(tmpRuleStr, ",")
    tmpHandle = Split(tmpHandleStr, " ")
    
    tmpRuleStr = tmpRule(Val(Left(strcode, 1)))
    tmpHandleStr = tmpHandle(Val(Left(strcode, 1)))
    tmpStr = tmpHandleStr & "!"
    For i = 1 To 6
        tmpStr2 = Mid(strcode, i + 1, 1)
        If Mid(tmpRuleStr, i, 1) = "A" Then
            tmpStr = tmpStr & tmpStr2
        Else
            tmpStr = tmpStr & chr(Val(tmpStr2) + 65)
        End If
    Next
    tmpStr = tmpStr & "-"
    For i = 7 To 12
        tmpStr2 = Mid(strcode, i + 1, 1)
        tmpStr = tmpStr & chr(Val(tmpStr2) + 97)
    Next
    getEan13Code = tmpStr & "!"
End Function