[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[原创] vba生成Code128B码

胡乱写写,依然是vba控制单元格粗细呈现code128b码,很遗憾没能实现code128 auto,占地面积会大点。(仅支持WPS pro2016)
  1. '计算CODE128校验位
  2. Private Function Get_CODE128_CheckSum(rawString As String, idx As Object)
  3.     Dim s As Integer
  4.     s = 0
  5.     For i = 1 To Len(rawString)
  6.         s = s + idx(Mid$(rawString, i, 1)) * i
  7.     Next
  8.     '函数返回值
  9.     Get_CODE128_CheckSum = (s + idx("StartB")) Mod 103
  10. End Function
  11. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  12. '填充CODE128码区边界
  13. Private Function Fill_CODE128_Bounds(ByVal x As Integer, ByVal y As Integer)
  14.     '初始化码区尺寸、背景色
  15.     For i = 1 To 300
  16.        Cells(y, x + i).ColumnWidth = 0.2
  17.        Cells(y, x + i).RowHeight = 100
  18.        Cells(y, x + i).Interior.ColorIndex = 0
  19.     Next
  20. End Function
  21. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  22. '填充CODE128条码线
  23. Private Function Fill_CODE128_Lines(ByVal x As Integer, ByVal y As Integer, ByVal m As Integer, rawString As String)
  24.     Dim pOffSet As Integer
  25.     pOffSet = 0
  26.     For i = 1 To m
  27.    
  28.         For j = 0 To (Val(Mid$(rawString, i, 1)) - 1)
  29.                 Cells(y, x + pOffSet + j).Interior.ColorIndex = (i Mod 2)
  30.         Next j
  31.         
  32.         pOffSet = pOffSet + j
  33.     Next i
  34.     '函数返回值
  35.     Fill_CODE128_Lines = 0
  36. End Function
  37. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  38. '主过程
  39. Private Sub worksheet_change(ByVal Target As Range)
  40.     'Append_EAN_Checksum焦点不在目标区域则退出
  41.     If Target.Address <> "$A$1" Then
  42.         Exit Sub
  43.     End If
  44.    
  45.     '创建dic字典
  46.     Dim dic As Object
  47.     Set dic = CreateObject("Scripting.Dictionary")
  48.    
  49.     '初始化字典主键
  50.     dic.Add " ", "212222"
  51.     dic.Add "!", "222122"
  52.     dic.Add """", "222221"
  53.     dic.Add "#", "121223"
  54.     dic.Add "$", "121322"
  55.     dic.Add "%", "131222"
  56.     dic.Add "&", "122213"
  57.     dic.Add "'", "122312"
  58.     dic.Add "(", "132212"
  59.     dic.Add ")", "221213"
  60.     dic.Add "*", "221312"
  61.     dic.Add "+", "231212"
  62.     dic.Add ",", "112232"
  63.     dic.Add "-", "122132"
  64.     dic.Add ".", "122231"
  65.     dic.Add "/", "113222"
  66.     dic.Add "0", "123122"
  67.     dic.Add "1", "123221"
  68.     dic.Add "2", "223211"
  69.     dic.Add "3", "221132"
  70.     dic.Add "4", "221231"
  71.     dic.Add "5", "213212"
  72.     dic.Add "6", "223112"
  73.     dic.Add "7", "312131"
  74.     dic.Add "8", "311222"
  75.     dic.Add "9", "321122"
  76.     dic.Add ":", "321221"
  77.     dic.Add ";", "312212"
  78.     dic.Add "<", "322112"
  79.     dic.Add "=", "322211"
  80.     dic.Add ">", "212123"
  81.     dic.Add "?", "212321"
  82.     dic.Add "@", "232121"
  83.     dic.Add "A", "111323"
  84.     dic.Add "B", "131123"
  85.     dic.Add "C", "131321"
  86.     dic.Add "D", "112313"
  87.     dic.Add "E", "132113"
  88.     dic.Add "F", "132311"
  89.     dic.Add "G", "211313"
  90.     dic.Add "H", "231113"
  91.     dic.Add "I", "231311"
  92.     dic.Add "J", "112133"
  93.     dic.Add "K", "112331"
  94.     dic.Add "L", "132131"
  95.     dic.Add "M", "113123"
  96.     dic.Add "N", "113321"
  97.     dic.Add "O", "133121"
  98.     dic.Add "P", "313121"
  99.     dic.Add "Q", "211331"
  100.     dic.Add "R", "231131"
  101.     dic.Add "S", "213113"
  102.     dic.Add "T", "213311"
  103.     dic.Add "U", "213131"
  104.     dic.Add "V", "311123"
  105.     dic.Add "W", "311321"
  106.     dic.Add "X", "331121"
  107.     dic.Add "Y", "312113"
  108.     dic.Add "Z", "312311"
  109.     dic.Add "[", "332111"
  110.     dic.Add "\", "314111"
  111.     dic.Add "]", "221411"
  112.     dic.Add "^", "431111"
  113.     dic.Add "_", "111224"
  114.     dic.Add "`", "111422"
  115.     dic.Add "a", "121124"
  116.     dic.Add "b", "121421"
  117.     dic.Add "c", "141122"
  118.     dic.Add "d", "141221"
  119.     dic.Add "e", "112214"
  120.     dic.Add "f", "112412"
  121.     dic.Add "g", "122114"
  122.     dic.Add "h", "122411"
  123.     dic.Add "i", "142112"
  124.     dic.Add "j", "142211"
  125.     dic.Add "k", "241211"
  126.     dic.Add "l", "221114"
  127.     dic.Add "m", "413111"
  128.     dic.Add "n", "241112"
  129.     dic.Add "o", "134111"
  130.     dic.Add "p", "111242"
  131.     dic.Add "q", "121142"
  132.     dic.Add "r", "121241"
  133.     dic.Add "s", "114212"
  134.     dic.Add "t", "124112"
  135.     dic.Add "u", "124211"
  136.     dic.Add "v", "411212"
  137.     dic.Add "w", "421112"
  138.     dic.Add "x", "421211"
  139.     dic.Add "y", "212141"
  140.     dic.Add "z", "214121"
  141.     dic.Add "{", "412121"
  142.     dic.Add "|", "111143"
  143.     dic.Add "}", "111341"
  144.     dic.Add "~", "131141"
  145.     dic.Add "DEL", "114113"
  146.     dic.Add "FNC3", "114311"
  147.     dic.Add "FNC2", "411113"
  148.     dic.Add "SHIFT", "411311"
  149.     dic.Add "CODEC", "113141"
  150.     dic.Add "FNC4", "114131"
  151.     dic.Add "CODEA", "311141"
  152.     dic.Add "FNC1", "411131"
  153.     dic.Add "StartA", "211412"
  154.     dic.Add "StartB", "211214"
  155.     dic.Add "StartC", "211232"
  156.     dic.Add "Stop", "2331112"
  157.     '创建dic字典索引idx
  158.     Dim idx As Object
  159.     Set idx = CreateObject("Scripting.Dictionary")
  160.    
  161.     '初始化字典主、索引
  162.     idx.Add " ", "0"
  163.     idx.Add "!", "1"
  164.     idx.Add """", "2"
  165.     idx.Add "#", "3"
  166.     idx.Add "$", "4"
  167.     idx.Add "%", "5"
  168.     idx.Add "&", "6"
  169.     idx.Add "'", "7"
  170.     idx.Add "(", "8"
  171.     idx.Add ")", "9"
  172.     idx.Add "*", "10"
  173.     idx.Add "+", "11"
  174.     idx.Add ",", "12"
  175.     idx.Add "-", "13"
  176.     idx.Add ".", "14"
  177.     idx.Add "/", "15"
  178.     idx.Add "0", "16"
  179.     idx.Add "1", "17"
  180.     idx.Add "2", "18"
  181.     idx.Add "3", "19"
  182.     idx.Add "4", "20"
  183.     idx.Add "5", "21"
  184.     idx.Add "6", "22"
  185.     idx.Add "7", "23"
  186.     idx.Add "8", "24"
  187.     idx.Add "9", "25"
  188.     idx.Add ":", "26"
  189.     idx.Add ";", "27"
  190.     idx.Add "<", "28"
  191.     idx.Add "=", "29"
  192.     idx.Add ">", "30"
  193.     idx.Add "?", "31"
  194.     idx.Add "@", "32"
  195.     idx.Add "A", "33"
  196.     idx.Add "B", "34"
  197.     idx.Add "C", "35"
  198.     idx.Add "D", "36"
  199.     idx.Add "E", "37"
  200.     idx.Add "F", "38"
  201.     idx.Add "G", "39"
  202.     idx.Add "H", "40"
  203.     idx.Add "I", "41"
  204.     idx.Add "J", "42"
  205.     idx.Add "K", "43"
  206.     idx.Add "L", "44"
  207.     idx.Add "M", "45"
  208.     idx.Add "N", "46"
  209.     idx.Add "O", "47"
  210.     idx.Add "P", "48"
  211.     idx.Add "Q", "49"
  212.     idx.Add "R", "50"
  213.     idx.Add "S", "51"
  214.     idx.Add "T", "52"
  215.     idx.Add "U", "53"
  216.     idx.Add "V", "54"
  217.     idx.Add "W", "55"
  218.     idx.Add "X", "56"
  219.     idx.Add "Y", "57"
  220.     idx.Add "Z", "58"
  221.     idx.Add "[", "59"
  222.     idx.Add "\", "60"
  223.     idx.Add "]", "61"
  224.     idx.Add "^", "62"
  225.     idx.Add "_", "63"
  226.     idx.Add "`", "64"
  227.     idx.Add "a", "65"
  228.     idx.Add "b", "66"
  229.     idx.Add "c", "67"
  230.     idx.Add "d", "68"
  231.     idx.Add "e", "69"
  232.     idx.Add "f", "70"
  233.     idx.Add "g", "71"
  234.     idx.Add "h", "72"
  235.     idx.Add "i", "73"
  236.     idx.Add "j", "74"
  237.     idx.Add "k", "75"
  238.     idx.Add "l", "76"
  239.     idx.Add "m", "77"
  240.     idx.Add "n", "78"
  241.     idx.Add "o", "79"
  242.     idx.Add "p", "80"
  243.     idx.Add "q", "81"
  244.     idx.Add "r", "82"
  245.     idx.Add "s", "83"
  246.     idx.Add "t", "84"
  247.     idx.Add "u", "85"
  248.     idx.Add "v", "86"
  249.     idx.Add "w", "87"
  250.     idx.Add "x", "88"
  251.     idx.Add "y", "89"
  252.     idx.Add "z", "90"
  253.     idx.Add "{", "91"
  254.     idx.Add "|", "92"
  255.     idx.Add "}", "93"
  256.     idx.Add "~", "94"
  257.     idx.Add "DEL", "95"
  258.     idx.Add "FNC3", "96"
  259.     idx.Add "FNC2", "97"
  260.     idx.Add "SHIFT", "98"
  261.     idx.Add "CODEC", "99"
  262.     idx.Add "FNC4", "100"
  263.     idx.Add "CODEA", "101"
  264.     idx.Add "FNC1", "102"
  265.     idx.Add "StartA", "103"
  266.     idx.Add "StartB", "104"
  267.     idx.Add "StartC", "105"
  268.     idx.Add "Stop", "106"
  269.    
  270.     '输入字符串
  271.     Dim iStr As String
  272.     iStr = Range("$A$1").Text
  273.    
  274.     '要绘制的坐标区域
  275.     Dim x, y As Integer
  276.     x = 2
  277.     y = 3
  278.    
  279.     '调用CODE128绘线函数
  280.     Dim ret, checkNum As Integer
  281.    
  282.     '初始化码区边界
  283.     ret = Fill_CODE128_Bounds(x, y)
  284.    
  285.     '绘制开始符
  286.     ret = Fill_CODE128_Lines(x, y, 6, dic("StartB"))
  287.    
  288.     '绘制数据位
  289.     For i = 1 To Len(iStr)
  290.         ret = Fill_CODE128_Lines(x + 11 * (i - 1) + 11, y, 6, dic(Mid$(iStr, i, 1)))
  291.     Next
  292.    
  293.     '绘制校验符
  294.     checkNum = Get_CODE128_CheckSum(iStr, idx)
  295.     ret = Fill_CODE128_Lines(x + Len(iStr) * 11 + 11, y, 6, dic(Chr(checkNum + 32)))
  296.    
  297.     '绘制结束符
  298.     ret = Fill_CODE128_Lines(x + Len(iStr) * 11 + 11 + 11, y, 7, dic("Stop"))
  299. End Sub
  300. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
复制代码

返回列表