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 FunctionVBA ean13字体 条码

解决方案 »

  1.   

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

  2.   

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

  3.   

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

  4.   

    问题已解决。在网上搜了一个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