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

happy886rr

【原创】不借助任何库，只用vba控制单元格颜色和宽窄，生成商品条码，扫描效果极佳，适合批量打印条码价签。

'计算EAN13校验位
Private Function Get_EAN_CheckSum(rawString As String)
 
    Dim checkSum As Integer
    checkSum = 0
 
    For i = 2 To 12 Step 2
        checkSum = checkSum + Val(Mid$(rawString, i, 1))
    Next
 
    checkSum = checkSum * 3
    For i = 1 To 11 Step 2
        checkSum = checkSum + Val(Mid$(rawString, i, 1))
    Next
 
    '函数返回值
    Get_EAN_CheckSum = (10 - (checkSum Mod 10)) Mod 10
 
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'填充EAN码区边界
Private Function Fill_EAN_Bounds(ByVal x As Integer, ByVal y As Integer)
 
    '初始化码区尺寸、背景色
    For i = 1 To 100
       Cells(y, x + i).ColumnWidth = 0.2
       Cells(y, x + i).RowHeight = 100
       Cells(y, x + i).Interior.ColorIndex = 0
       
       Cells(y + 1, x + i).ColumnWidth = 0.2
       Cells(y + 1, x + i).RowHeight = 20
       Cells(y + 1, x + i).Interior.ColorIndex = 0
    Next
      
    '初始化码区左侧起始线
    Cells(y, x + 1).Interior.ColorIndex = 1
    Cells(y + 1, x + 1).Interior.ColorIndex = 1
 
    Cells(y, x + 2).Interior.ColorIndex = 0
    Cells(y + 1, x + 2).Interior.ColorIndex = 0
 
    Cells(y, x + 3).Interior.ColorIndex = 1
    Cells(y + 1, x + 3).Interior.ColorIndex = 1
 
    '初始化码区中间线
    Cells(y, x + 46).Interior.ColorIndex = 0
    Cells(y + 1, x + 46).Interior.ColorIndex = 0
 
    Cells(y, x + 47).Interior.ColorIndex = 1
    Cells(y + 1, x + 47).Interior.ColorIndex = 1
 
    Cells(y, x + 48).Interior.ColorIndex = 0
    Cells(y + 1, x + 48).Interior.ColorIndex = 0
 
    Cells(y, x + 49).Interior.ColorIndex = 1
    Cells(y + 1, x + 49).Interior.ColorIndex = 1
 
    Cells(y, x + 50).Interior.ColorIndex = 0
    Cells(y + 1, x + 50).Interior.ColorIndex = 0
 
    '初始化码区右侧终止线
    Cells(y, x + 93).Interior.ColorIndex = 1
    Cells(y + 1, x + 93).Interior.ColorIndex = 1
 
    Cells(y, x + 94).Interior.ColorIndex = 0
    Cells(y + 1, x + 94).Interior.ColorIndex = 0
 
    Cells(y, x + 95).Interior.ColorIndex = 1
    Cells(y + 1, x + 95).Interior.ColorIndex = 1
 
    '函数返回值
    Fill_EAN_Bounds = 0
 
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'填充EAN13条码线
Private Function Fill_EAN_Lines(ByVal x As Integer, ByVal y As Integer, ByVal n As Integer)
 
    For i = 0 To 6
            Cells(y, x + i).Interior.ColorIndex = IIf(n And (2 ^ (6 - i)), 1, 0)
    Next
 
    '函数返回值
    Fill_EAN_Lines = 0
 
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'主过程
Private Sub worksheet_change(ByVal Target As Range)
 
    '焦点不在目标区域则退出
    If Target.Address <> "$A$1" Then
        Exit Sub
    End If
    
    '初始化参量数组
    Dim preModeCode, abModeCode, cModeCode
    '前置码数组
    preModeCode = Array(0, 11, 13, 14, 19, 25, 28, 21, 22, 26)
    'AB模式数组
    abModeCode = Array(Array(13, 25, 19, 61, 35, 49, 47, 59, 55, 11), Array(39, 51, 27, 33, 29, 57, 5, 17, 9, 23))
    'C模式数组
    cModeCode = Array(114, 102, 108, 66, 92, 78, 80, 68, 72, 116)
 
    '获取输入的条码
    Dim inText As String
    inText = Range("$A$1").Text
 
    '将输入的EAN13码拆分为输入码数组
    ReDim inCode(0 To Len(inText) - 1)
    For i = 0 To Len(inText) - 1
        inCode(i) = Mid(inText, i + 1, 1)
    Next
 
    '计算校验位
    Dim checkSum As Integer
    checkSum = Get_EAN_CheckSum(inText)
    '将校验位压入数组
    inCode(Len(inText) - 1) = checkSum
    
    '要绘制的坐标位置
    Dim startX, startY As Integer
    startX = 3
    startY = 3
    
    '绘制码区边界
    Dim f, p, t, s As Integer
    f = Fill_EAN_Bounds(startX, startY)
 
 
    p = preModeCode(inCode(0))
    For i = 0 To 5
       t = IIf(p And (2 ^ (5 - i)), 1, 0)
       s = Fill_EAN_Lines(4 + startX + 7 * i, startY, abModeCode(t)(inCode(i + 1)))
    Next
 
    For i = 6 To 11
       s = Fill_EAN_Lines(9 + startX + 7 * i, startY, cModeCode(inCode(i + 1)))
    Next
 
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''COPY

523066680

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

happy886rr

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

523066680

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

happy886rr

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

523066680

回复 5# happy886rr

    嗖噶

happy886rr

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

523066680

回复 7# happy886rr


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

happy886rr

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

happy886rr

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

523066680

回复 10# happy886rr

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

happy886rr

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

523066680

回复 12# happy886rr


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

happy886rr

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

523066680

回复 14# happy886rr

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

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