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

[原创] [原创]vba生成商品条形码

【原创】不借助任何库,只用vba控制单元格颜色和宽窄,生成商品条码,扫描效果极佳,适合批量打印条码价签。
  1. '计算EAN13校验位
  2. Private Function Get_EAN_CheckSum(rawString As String)
  3.     Dim checkSum As Integer
  4.     checkSum = 0
  5.     For i = 2 To 12 Step 2
  6.         checkSum = checkSum + Val(Mid$(rawString, i, 1))
  7.     Next
  8.     checkSum = checkSum * 3
  9.     For i = 1 To 11 Step 2
  10.         checkSum = checkSum + Val(Mid$(rawString, i, 1))
  11.     Next
  12.     '函数返回值
  13.     Get_EAN_CheckSum = (10 - (checkSum Mod 10)) Mod 10
  14. End Function
  15. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  16. '填充EAN码区边界
  17. Private Function Fill_EAN_Bounds(ByVal x As Integer, ByVal y As Integer)
  18.     '初始化码区尺寸、背景色
  19.     For i = 1 To 100
  20.        Cells(y, x + i).ColumnWidth = 0.2
  21.        Cells(y, x + i).RowHeight = 100
  22.        Cells(y, x + i).Interior.ColorIndex = 0
  23.       
  24.        Cells(y + 1, x + i).ColumnWidth = 0.2
  25.        Cells(y + 1, x + i).RowHeight = 20
  26.        Cells(y + 1, x + i).Interior.ColorIndex = 0
  27.     Next
  28.       
  29.     '初始化码区左侧起始线
  30.     Cells(y, x + 1).Interior.ColorIndex = 1
  31.     Cells(y + 1, x + 1).Interior.ColorIndex = 1
  32.     Cells(y, x + 2).Interior.ColorIndex = 0
  33.     Cells(y + 1, x + 2).Interior.ColorIndex = 0
  34.     Cells(y, x + 3).Interior.ColorIndex = 1
  35.     Cells(y + 1, x + 3).Interior.ColorIndex = 1
  36.     '初始化码区中间线
  37.     Cells(y, x + 46).Interior.ColorIndex = 0
  38.     Cells(y + 1, x + 46).Interior.ColorIndex = 0
  39.     Cells(y, x + 47).Interior.ColorIndex = 1
  40.     Cells(y + 1, x + 47).Interior.ColorIndex = 1
  41.     Cells(y, x + 48).Interior.ColorIndex = 0
  42.     Cells(y + 1, x + 48).Interior.ColorIndex = 0
  43.     Cells(y, x + 49).Interior.ColorIndex = 1
  44.     Cells(y + 1, x + 49).Interior.ColorIndex = 1
  45.     Cells(y, x + 50).Interior.ColorIndex = 0
  46.     Cells(y + 1, x + 50).Interior.ColorIndex = 0
  47.     '初始化码区右侧终止线
  48.     Cells(y, x + 93).Interior.ColorIndex = 1
  49.     Cells(y + 1, x + 93).Interior.ColorIndex = 1
  50.     Cells(y, x + 94).Interior.ColorIndex = 0
  51.     Cells(y + 1, x + 94).Interior.ColorIndex = 0
  52.     Cells(y, x + 95).Interior.ColorIndex = 1
  53.     Cells(y + 1, x + 95).Interior.ColorIndex = 1
  54.     '函数返回值
  55.     Fill_EAN_Bounds = 0
  56. End Function
  57. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  58. '填充EAN13条码线
  59. Private Function Fill_EAN_Lines(ByVal x As Integer, ByVal y As Integer, ByVal n As Integer)
  60.     For i = 0 To 6
  61.             Cells(y, x + i).Interior.ColorIndex = IIf(n And (2 ^ (6 - i)), 1, 0)
  62.     Next
  63.     '函数返回值
  64.     Fill_EAN_Lines = 0
  65. End Function
  66. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  67. '主过程
  68. Private Sub worksheet_change(ByVal Target As Range)
  69.     '焦点不在目标区域则退出
  70.     If Target.Address <> "$A$1" Then
  71.         Exit Sub
  72.     End If
  73.    
  74.     '初始化参量数组
  75.     Dim preModeCode, abModeCode, cModeCode
  76.     '前置码数组
  77.     preModeCode = Array(0, 11, 13, 14, 19, 25, 28, 21, 22, 26)
  78.     'AB模式数组
  79.     abModeCode = Array(Array(13, 25, 19, 61, 35, 49, 47, 59, 55, 11), Array(39, 51, 27, 33, 29, 57, 5, 17, 9, 23))
  80.     'C模式数组
  81.     cModeCode = Array(114, 102, 108, 66, 92, 78, 80, 68, 72, 116)
  82.     '获取输入的条码
  83.     Dim inText As String
  84.     inText = Range("$A$1").Text
  85.     '将输入的EAN13码拆分为输入码数组
  86.     ReDim inCode(0 To Len(inText) - 1)
  87.     For i = 0 To Len(inText) - 1
  88.         inCode(i) = Mid(inText, i + 1, 1)
  89.     Next
  90.     '计算校验位
  91.     Dim checkSum As Integer
  92.     checkSum = Get_EAN_CheckSum(inText)
  93.     '将校验位压入数组
  94.     inCode(Len(inText) - 1) = checkSum
  95.    
  96.     '要绘制的坐标位置
  97.     Dim startX, startY As Integer
  98.     startX = 3
  99.     startY = 3
  100.    
  101.     '绘制码区边界
  102.     Dim f, p, t, s As Integer
  103.     f = Fill_EAN_Bounds(startX, startY)
  104.     p = preModeCode(inCode(0))
  105.     For i = 0 To 5
  106.        t = IIf(p And (2 ^ (5 - i)), 1, 0)
  107.        s = Fill_EAN_Lines(4 + startX + 7 * i, startY, abModeCode(t)(inCode(i + 1)))
  108.     Next
  109.     For i = 6 To 11
  110.        s = Fill_EAN_Lines(9 + startX + 7 * i, startY, cModeCode(inCode(i + 1)))
  111.     Next
  112. End Sub
  113. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
复制代码
1

评分人数

本帖最后由 523066680 于 2018-11-13 08:32 编辑

批量打印条码 的正确方案是买个热敏条码打印机。
在这之前我用的是Coreldraw制作生成条码, coreldraw也带vba,但是你用普通打印机,始终要自己裁。
15年用上了条码打印机,只能说相见恨晚。

TOP

本帖最后由 happy886rr 于 2018-11-13 08:52 编辑

回复 2# 523066680
我有4台TSC 244pro,用自己写的工具去驱动TSC批量打。就是碳带费点。

TOP

本帖最后由 523066680 于 2018-11-13 08:54 编辑

回复 3# happy886rr
厉害。
条码打印机应该自带自动化的软件,包括图标插入、编排、序列自动递增等功能,按理说不用涉及到手写工具

TOP

回复 4# 523066680
有,但是不能自己随心所欲设计。我可以自己写代码,做出各种码式,加艺术字。甚至创建自己定义的条码,然后用zxing库创建手机app扫描自己定义的新式条形码。

TOP

回复 5# happy886rr

    嗖噶

TOP

回复 6# 523066680
你的树莓派在哪买的

TOP

回复 7# happy886rr


    我没买树莓派呀,只买过arduino nano,在淘宝。
你要问的人是 bbaa 吧?他用树莓派在消遣区自动发帖。(可能是要做一个自动回帖机器人,好像最近不活跃了

TOP

本帖最后由 happy886rr 于 2018-11-13 09:07 编辑

回复 8# 523066680
用电脑运行太费电,还是小型arm机比较划算,搭建各种迷你云。
1

评分人数

TOP

回复 8# 523066680
你在论坛待十年了,今年是你十周年坛龄。

TOP

回复 10# happy886rr

这都被你发现。
最近颓废,沉迷游戏和漫画…… 没做什么东西出来。
游戏在克制,但是《火凤燎原》真的很精彩。

TOP

本帖最后由 happy886rr 于 2018-11-13 09:23 编辑

回复 11# 523066680
国漫也不错,你可以看看不良人动画挺精彩,还有那个换世门生里边的念阳枭颇像你。游戏我也天天玩,每天3小时CF
我就是念阳枭

TOP

回复 12# happy886rr


    我现在挺矛盾,但是又庆幸早几年没有沉迷虚度。
(关于爬虫脚本耗电问题,我的脚本都在电脑跑,没有天天跑,电费不管他啦。)

TOP

回复 13# 523066680
就是12楼的那个图

TOP

本帖最后由 523066680 于 2018-11-17 15:29 编辑

回复 14# happy886rr

    叼炸了。
说道爬图片,悄悄发个链接 .com/model/Sloan-Kendricks/
后面有人的话请勿打开

这个网站扒起来很有成就感……

TOP

返回列表