Board logo

标题: [原创] vba生成Code128B码 [打印本页]
作者: happy886rr    时间: 2018-11-17 22:38     标题: vba生成Code128B码

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

  2. Private Function Get_CODE128_CheckSum(rawString As String, idx As Object)

  3. 

  4.     Dim s As Integer

  5.     s = 0

  6. 

  7.     For i = 1 To Len(rawString)

  8.         s = s + idx(Mid$(rawString, i, 1)) * i

  9.     Next

  10. 

  11.     '函数返回值

  12.     Get_CODE128_CheckSum = (s + idx("StartB")) Mod 103

  13. 

  14. End Function

  15. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

  16. 

  17. '填充CODE128码区边界

  18. Private Function Fill_CODE128_Bounds(ByVal x As Integer, ByVal y As Integer)

  19. 

  20.     '初始化码区尺寸、背景色

  21.     For i = 1 To 300

  22.        Cells(y, x + i).ColumnWidth = 0.2

  23.        Cells(y, x + i).RowHeight = 100

  24.        Cells(y, x + i).Interior.ColorIndex = 0

  25.     Next

  26. End Function

  27. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

  28. 

  29. 

  30. '填充CODE128条码线

  31. Private Function Fill_CODE128_Lines(ByVal x As Integer, ByVal y As Integer, ByVal m As Integer, rawString As String)

  32. 

  33.     Dim pOffSet As Integer

  34.     pOffSet = 0

  35. 

  36.     For i = 1 To m

  37.     

  38.         For j = 0 To (Val(Mid$(rawString, i, 1)) - 1)

  39.                 Cells(y, x + pOffSet + j).Interior.ColorIndex = (i Mod 2)

  40.         Next j

  41.         

  42.         pOffSet = pOffSet + j

  43.     Next i

  44. 

  45.     '函数返回值

  46.     Fill_CODE128_Lines = 0

  47. 

  48. End Function

  49. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

  50. 

  51. '主过程

  52. Private Sub worksheet_change(ByVal Target As Range)

  53. 

  54.     'Append_EAN_Checksum焦点不在目标区域则退出

  55.     If Target.Address <> "$A$1" Then

  56.         Exit Sub

  57.     End If

  58.     

  59.     '创建dic字典

  60.     Dim dic As Object

  61.     Set dic = CreateObject("Scripting.Dictionary")

  62.     

  63.     '初始化字典主键

  64.     dic.Add " ", "212222"

  65.     dic.Add "!", "222122"

  66.     dic.Add """", "222221"

  67.     dic.Add "#", "121223"

  68.     dic.Add "$", "121322"

  69.     dic.Add "%", "131222"

  70.     dic.Add "&", "122213"

  71.     dic.Add "'", "122312"

  72.     dic.Add "(", "132212"

  73.     dic.Add ")", "221213"

  74.     dic.Add "*", "221312"

  75.     dic.Add "+", "231212"

  76.     dic.Add ",", "112232"

  77.     dic.Add "-", "122132"

  78.     dic.Add ".", "122231"

  79.     dic.Add "/", "113222"

  80.     dic.Add "0", "123122"

  81.     dic.Add "1", "123221"

  82.     dic.Add "2", "223211"

  83.     dic.Add "3", "221132"

  84.     dic.Add "4", "221231"

  85.     dic.Add "5", "213212"

  86.     dic.Add "6", "223112"

  87.     dic.Add "7", "312131"

  88.     dic.Add "8", "311222"

  89.     dic.Add "9", "321122"

  90.     dic.Add ":", "321221"

  91.     dic.Add ";", "312212"

  92.     dic.Add "<", "322112"

  93.     dic.Add "=", "322211"

  94.     dic.Add ">", "212123"

  95.     dic.Add "?", "212321"

  96.     dic.Add "@", "232121"

  97.     dic.Add "A", "111323"

  98.     dic.Add "B", "131123"

  99.     dic.Add "C", "131321"

  100.     dic.Add "D", "112313"

  101.     dic.Add "E", "132113"

  102.     dic.Add "F", "132311"

  103.     dic.Add "G", "211313"

  104.     dic.Add "H", "231113"

  105.     dic.Add "I", "231311"

  106.     dic.Add "J", "112133"

  107.     dic.Add "K", "112331"

  108.     dic.Add "L", "132131"

  109.     dic.Add "M", "113123"

  110.     dic.Add "N", "113321"

  111.     dic.Add "O", "133121"

  112.     dic.Add "P", "313121"

  113.     dic.Add "Q", "211331"

  114.     dic.Add "R", "231131"

  115.     dic.Add "S", "213113"

  116.     dic.Add "T", "213311"

  117.     dic.Add "U", "213131"

  118.     dic.Add "V", "311123"

  119.     dic.Add "W", "311321"

  120.     dic.Add "X", "331121"

  121.     dic.Add "Y", "312113"

  122.     dic.Add "Z", "312311"

  123.     dic.Add "[", "332111"

  124.     dic.Add "\", "314111"

  125.     dic.Add "]", "221411"

  126.     dic.Add "^", "431111"

  127.     dic.Add "_", "111224"

  128.     dic.Add "`", "111422"

  129.     dic.Add "a", "121124"

  130.     dic.Add "b", "121421"

  131.     dic.Add "c", "141122"

  132.     dic.Add "d", "141221"

  133.     dic.Add "e", "112214"

  134.     dic.Add "f", "112412"

  135.     dic.Add "g", "122114"

  136.     dic.Add "h", "122411"

  137.     dic.Add "i", "142112"

  138.     dic.Add "j", "142211"

  139.     dic.Add "k", "241211"

  140.     dic.Add "l", "221114"

  141.     dic.Add "m", "413111"

  142.     dic.Add "n", "241112"

  143.     dic.Add "o", "134111"

  144.     dic.Add "p", "111242"

  145.     dic.Add "q", "121142"

  146.     dic.Add "r", "121241"

  147.     dic.Add "s", "114212"

  148.     dic.Add "t", "124112"

  149.     dic.Add "u", "124211"

  150.     dic.Add "v", "411212"

  151.     dic.Add "w", "421112"

  152.     dic.Add "x", "421211"

  153.     dic.Add "y", "212141"

  154.     dic.Add "z", "214121"

  155.     dic.Add "{", "412121"

  156.     dic.Add "|", "111143"

  157.     dic.Add "}", "111341"

  158.     dic.Add "~", "131141"

  159.     dic.Add "DEL", "114113"

  160.     dic.Add "FNC3", "114311"

  161.     dic.Add "FNC2", "411113"

  162.     dic.Add "SHIFT", "411311"

  163.     dic.Add "CODEC", "113141"

  164.     dic.Add "FNC4", "114131"

  165.     dic.Add "CODEA", "311141"

  166.     dic.Add "FNC1", "411131"

  167.     dic.Add "StartA", "211412"

  168.     dic.Add "StartB", "211214"

  169.     dic.Add "StartC", "211232"

  170.     dic.Add "Stop", "2331112"

  171. 

  172.     '创建dic字典索引idx

  173.     Dim idx As Object

  174.     Set idx = CreateObject("Scripting.Dictionary")

  175.     

  176.     '初始化字典主、索引

  177.     idx.Add " ", "0"

  178.     idx.Add "!", "1"

  179.     idx.Add """", "2"

  180.     idx.Add "#", "3"

  181.     idx.Add "$", "4"

  182.     idx.Add "%", "5"

  183.     idx.Add "&", "6"

  184.     idx.Add "'", "7"

  185.     idx.Add "(", "8"

  186.     idx.Add ")", "9"

  187.     idx.Add "*", "10"

  188.     idx.Add "+", "11"

  189.     idx.Add ",", "12"

  190.     idx.Add "-", "13"

  191.     idx.Add ".", "14"

  192.     idx.Add "/", "15"

  193.     idx.Add "0", "16"

  194.     idx.Add "1", "17"

  195.     idx.Add "2", "18"

  196.     idx.Add "3", "19"

  197.     idx.Add "4", "20"

  198.     idx.Add "5", "21"

  199.     idx.Add "6", "22"

  200.     idx.Add "7", "23"

  201.     idx.Add "8", "24"

  202.     idx.Add "9", "25"

  203.     idx.Add ":", "26"

  204.     idx.Add ";", "27"

  205.     idx.Add "<", "28"

  206.     idx.Add "=", "29"

  207.     idx.Add ">", "30"

  208.     idx.Add "?", "31"

  209.     idx.Add "@", "32"

  210.     idx.Add "A", "33"

  211.     idx.Add "B", "34"

  212.     idx.Add "C", "35"

  213.     idx.Add "D", "36"

  214.     idx.Add "E", "37"

  215.     idx.Add "F", "38"

  216.     idx.Add "G", "39"

  217.     idx.Add "H", "40"

  218.     idx.Add "I", "41"

  219.     idx.Add "J", "42"

  220.     idx.Add "K", "43"

  221.     idx.Add "L", "44"

  222.     idx.Add "M", "45"

  223.     idx.Add "N", "46"

  224.     idx.Add "O", "47"

  225.     idx.Add "P", "48"

  226.     idx.Add "Q", "49"

  227.     idx.Add "R", "50"

  228.     idx.Add "S", "51"

  229.     idx.Add "T", "52"

  230.     idx.Add "U", "53"

  231.     idx.Add "V", "54"

  232.     idx.Add "W", "55"

  233.     idx.Add "X", "56"

  234.     idx.Add "Y", "57"

  235.     idx.Add "Z", "58"

  236.     idx.Add "[", "59"

  237.     idx.Add "\", "60"

  238.     idx.Add "]", "61"

  239.     idx.Add "^", "62"

  240.     idx.Add "_", "63"

  241.     idx.Add "`", "64"

  242.     idx.Add "a", "65"

  243.     idx.Add "b", "66"

  244.     idx.Add "c", "67"

  245.     idx.Add "d", "68"

  246.     idx.Add "e", "69"

  247.     idx.Add "f", "70"

  248.     idx.Add "g", "71"

  249.     idx.Add "h", "72"

  250.     idx.Add "i", "73"

  251.     idx.Add "j", "74"

  252.     idx.Add "k", "75"

  253.     idx.Add "l", "76"

  254.     idx.Add "m", "77"

  255.     idx.Add "n", "78"

  256.     idx.Add "o", "79"

  257.     idx.Add "p", "80"

  258.     idx.Add "q", "81"

  259.     idx.Add "r", "82"

  260.     idx.Add "s", "83"

  261.     idx.Add "t", "84"

  262.     idx.Add "u", "85"

  263.     idx.Add "v", "86"

  264.     idx.Add "w", "87"

  265.     idx.Add "x", "88"

  266.     idx.Add "y", "89"

  267.     idx.Add "z", "90"

  268.     idx.Add "{", "91"

  269.     idx.Add "|", "92"

  270.     idx.Add "}", "93"

  271.     idx.Add "~", "94"

  272.     idx.Add "DEL", "95"

  273.     idx.Add "FNC3", "96"

  274.     idx.Add "FNC2", "97"

  275.     idx.Add "SHIFT", "98"

  276.     idx.Add "CODEC", "99"

  277.     idx.Add "FNC4", "100"

  278.     idx.Add "CODEA", "101"

  279.     idx.Add "FNC1", "102"

  280.     idx.Add "StartA", "103"

  281.     idx.Add "StartB", "104"

  282.     idx.Add "StartC", "105"

  283.     idx.Add "Stop", "106"

  284.     

  285.     '输入字符串

  286.     Dim iStr As String

  287.     iStr = Range("$A$1").Text

  288.     

  289.     '要绘制的坐标区域

  290.     Dim x, y As Integer

  291.     x = 2

  292.     y = 3

  293.     

  294.     '调用CODE128绘线函数

  295.     Dim ret, checkNum As Integer

  296.     

  297.     '初始化码区边界

  298.     ret = Fill_CODE128_Bounds(x, y)

  299.     

  300.     '绘制开始符

  301.     ret = Fill_CODE128_Lines(x, y, 6, dic("StartB"))

  302.     

  303.     '绘制数据位

  304.     For i = 1 To Len(iStr)

  305.         ret = Fill_CODE128_Lines(x + 11 * (i - 1) + 11, y, 6, dic(Mid$(iStr, i, 1)))

  306.     Next

  307.     

  308.     '绘制校验符

  309.     checkNum = Get_CODE128_CheckSum(iStr, idx)

  310.     ret = Fill_CODE128_Lines(x + Len(iStr) * 11 + 11, y, 6, dic(Chr(checkNum + 32)))

  311.     

  312.     '绘制结束符

  313.     ret = Fill_CODE128_Lines(x + Len(iStr) * 11 + 11 + 11, y, 7, dic("Stop"))

  314. 

  315. End Sub

  316. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
复制代码




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2