[原创] vba生成Code128B码

happy886rr

胡乱写写，依然是vba控制单元格粗细呈现code128b码，很遗憾没能实现code128 auto，占地面积会大点。（仅支持WPS pro2016）

'计算CODE128校验位
Private Function Get_CODE128_CheckSum(rawString As String, idx As Object)
 
    Dim s As Integer
    s = 0
 
    For i = 1 To Len(rawString)
        s = s + idx(Mid$(rawString, i, 1)) * i
    Next
 
    '函数返回值
    Get_CODE128_CheckSum = (s + idx("StartB")) Mod 103
 
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'填充CODE128码区边界
Private Function Fill_CODE128_Bounds(ByVal x As Integer, ByVal y As Integer)
 
    '初始化码区尺寸、背景色
    For i = 1 To 300
       Cells(y, x + i).ColumnWidth = 0.2
       Cells(y, x + i).RowHeight = 100
       Cells(y, x + i).Interior.ColorIndex = 0
    Next
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
'填充CODE128条码线
Private Function Fill_CODE128_Lines(ByVal x As Integer, ByVal y As Integer, ByVal m As Integer, rawString As String)
 
    Dim pOffSet As Integer
    pOffSet = 0
 
    For i = 1 To m
    
        For j = 0 To (Val(Mid$(rawString, i, 1)) - 1)
                Cells(y, x + pOffSet + j).Interior.ColorIndex = (i Mod 2)
        Next j
        
        pOffSet = pOffSet + j
    Next i
 
    '函数返回值
    Fill_CODE128_Lines = 0
 
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'主过程
Private Sub worksheet_change(ByVal Target As Range)
 
    'Append_EAN_Checksum焦点不在目标区域则退出
    If Target.Address <> "$A$1" Then
        Exit Sub
    End If
    
    '创建dic字典
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    '初始化字典主键
    dic.Add " ", "212222"
    dic.Add "!", "222122"
    dic.Add """", "222221"
    dic.Add "#", "121223"
    dic.Add "$", "121322"
    dic.Add "%", "131222"
    dic.Add "&", "122213"
    dic.Add "'", "122312"
    dic.Add "(", "132212"
    dic.Add ")", "221213"
    dic.Add "*", "221312"
    dic.Add "+", "231212"
    dic.Add ",", "112232"
    dic.Add "-", "122132"
    dic.Add ".", "122231"
    dic.Add "/", "113222"
    dic.Add "0", "123122"
    dic.Add "1", "123221"
    dic.Add "2", "223211"
    dic.Add "3", "221132"
    dic.Add "4", "221231"
    dic.Add "5", "213212"
    dic.Add "6", "223112"
    dic.Add "7", "312131"
    dic.Add "8", "311222"
    dic.Add "9", "321122"
    dic.Add ":", "321221"
    dic.Add ";", "312212"
    dic.Add "<", "322112"
    dic.Add "=", "322211"
    dic.Add ">", "212123"
    dic.Add "?", "212321"
    dic.Add "@", "232121"
    dic.Add "A", "111323"
    dic.Add "B", "131123"
    dic.Add "C", "131321"
    dic.Add "D", "112313"
    dic.Add "E", "132113"
    dic.Add "F", "132311"
    dic.Add "G", "211313"
    dic.Add "H", "231113"
    dic.Add "I", "231311"
    dic.Add "J", "112133"
    dic.Add "K", "112331"
    dic.Add "L", "132131"
    dic.Add "M", "113123"
    dic.Add "N", "113321"
    dic.Add "O", "133121"
    dic.Add "P", "313121"
    dic.Add "Q", "211331"
    dic.Add "R", "231131"
    dic.Add "S", "213113"
    dic.Add "T", "213311"
    dic.Add "U", "213131"
    dic.Add "V", "311123"
    dic.Add "W", "311321"
    dic.Add "X", "331121"
    dic.Add "Y", "312113"
    dic.Add "Z", "312311"
    dic.Add "[", "332111"
    dic.Add "\", "314111"
    dic.Add "]", "221411"
    dic.Add "^", "431111"
    dic.Add "_", "111224"
    dic.Add "`", "111422"
    dic.Add "a", "121124"
    dic.Add "b", "121421"
    dic.Add "c", "141122"
    dic.Add "d", "141221"
    dic.Add "e", "112214"
    dic.Add "f", "112412"
    dic.Add "g", "122114"
    dic.Add "h", "122411"
    dic.Add "i", "142112"
    dic.Add "j", "142211"
    dic.Add "k", "241211"
    dic.Add "l", "221114"
    dic.Add "m", "413111"
    dic.Add "n", "241112"
    dic.Add "o", "134111"
    dic.Add "p", "111242"
    dic.Add "q", "121142"
    dic.Add "r", "121241"
    dic.Add "s", "114212"
    dic.Add "t", "124112"
    dic.Add "u", "124211"
    dic.Add "v", "411212"
    dic.Add "w", "421112"
    dic.Add "x", "421211"
    dic.Add "y", "212141"
    dic.Add "z", "214121"
    dic.Add "{", "412121"
    dic.Add "|", "111143"
    dic.Add "}", "111341"
    dic.Add "~", "131141"
    dic.Add "DEL", "114113"
    dic.Add "FNC3", "114311"
    dic.Add "FNC2", "411113"
    dic.Add "SHIFT", "411311"
    dic.Add "CODEC", "113141"
    dic.Add "FNC4", "114131"
    dic.Add "CODEA", "311141"
    dic.Add "FNC1", "411131"
    dic.Add "StartA", "211412"
    dic.Add "StartB", "211214"
    dic.Add "StartC", "211232"
    dic.Add "Stop", "2331112"
 
    '创建dic字典索引idx
    Dim idx As Object
    Set idx = CreateObject("Scripting.Dictionary")
    
    '初始化字典主、索引
    idx.Add " ", "0"
    idx.Add "!", "1"
    idx.Add """", "2"
    idx.Add "#", "3"
    idx.Add "$", "4"
    idx.Add "%", "5"
    idx.Add "&", "6"
    idx.Add "'", "7"
    idx.Add "(", "8"
    idx.Add ")", "9"
    idx.Add "*", "10"
    idx.Add "+", "11"
    idx.Add ",", "12"
    idx.Add "-", "13"
    idx.Add ".", "14"
    idx.Add "/", "15"
    idx.Add "0", "16"
    idx.Add "1", "17"
    idx.Add "2", "18"
    idx.Add "3", "19"
    idx.Add "4", "20"
    idx.Add "5", "21"
    idx.Add "6", "22"
    idx.Add "7", "23"
    idx.Add "8", "24"
    idx.Add "9", "25"
    idx.Add ":", "26"
    idx.Add ";", "27"
    idx.Add "<", "28"
    idx.Add "=", "29"
    idx.Add ">", "30"
    idx.Add "?", "31"
    idx.Add "@", "32"
    idx.Add "A", "33"
    idx.Add "B", "34"
    idx.Add "C", "35"
    idx.Add "D", "36"
    idx.Add "E", "37"
    idx.Add "F", "38"
    idx.Add "G", "39"
    idx.Add "H", "40"
    idx.Add "I", "41"
    idx.Add "J", "42"
    idx.Add "K", "43"
    idx.Add "L", "44"
    idx.Add "M", "45"
    idx.Add "N", "46"
    idx.Add "O", "47"
    idx.Add "P", "48"
    idx.Add "Q", "49"
    idx.Add "R", "50"
    idx.Add "S", "51"
    idx.Add "T", "52"
    idx.Add "U", "53"
    idx.Add "V", "54"
    idx.Add "W", "55"
    idx.Add "X", "56"
    idx.Add "Y", "57"
    idx.Add "Z", "58"
    idx.Add "[", "59"
    idx.Add "\", "60"
    idx.Add "]", "61"
    idx.Add "^", "62"
    idx.Add "_", "63"
    idx.Add "`", "64"
    idx.Add "a", "65"
    idx.Add "b", "66"
    idx.Add "c", "67"
    idx.Add "d", "68"
    idx.Add "e", "69"
    idx.Add "f", "70"
    idx.Add "g", "71"
    idx.Add "h", "72"
    idx.Add "i", "73"
    idx.Add "j", "74"
    idx.Add "k", "75"
    idx.Add "l", "76"
    idx.Add "m", "77"
    idx.Add "n", "78"
    idx.Add "o", "79"
    idx.Add "p", "80"
    idx.Add "q", "81"
    idx.Add "r", "82"
    idx.Add "s", "83"
    idx.Add "t", "84"
    idx.Add "u", "85"
    idx.Add "v", "86"
    idx.Add "w", "87"
    idx.Add "x", "88"
    idx.Add "y", "89"
    idx.Add "z", "90"
    idx.Add "{", "91"
    idx.Add "|", "92"
    idx.Add "}", "93"
    idx.Add "~", "94"
    idx.Add "DEL", "95"
    idx.Add "FNC3", "96"
    idx.Add "FNC2", "97"
    idx.Add "SHIFT", "98"
    idx.Add "CODEC", "99"
    idx.Add "FNC4", "100"
    idx.Add "CODEA", "101"
    idx.Add "FNC1", "102"
    idx.Add "StartA", "103"
    idx.Add "StartB", "104"
    idx.Add "StartC", "105"
    idx.Add "Stop", "106"
    
    '输入字符串
    Dim iStr As String
    iStr = Range("$A$1").Text
    
    '要绘制的坐标区域
    Dim x, y As Integer
    x = 2
    y = 3
    
    '调用CODE128绘线函数
    Dim ret, checkNum As Integer
    
    '初始化码区边界
    ret = Fill_CODE128_Bounds(x, y)
    
    '绘制开始符
    ret = Fill_CODE128_Lines(x, y, 6, dic("StartB"))
    
    '绘制数据位
    For i = 1 To Len(iStr)
        ret = Fill_CODE128_Lines(x + 11 * (i - 1) + 11, y, 6, dic(Mid$(iStr, i, 1)))
    Next
    
    '绘制校验符
    checkNum = Get_CODE128_CheckSum(iStr, idx)
    ret = Fill_CODE128_Lines(x + Len(iStr) * 11 + 11, y, 6, dic(Chr(checkNum + 32)))
    
    '绘制结束符
    ret = Fill_CODE128_Lines(x + Len(iStr) * 11 + 11 + 11, y, 7, dic("Stop"))
 
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''COPY