• 让山里娃感受智慧科技乐趣 2019-05-19
  • 香港田径锦标赛飞人夺冠 2019-05-19
  • 诽谤侮辱英烈可追刑责 2019-05-14
  • 图解:十二字“洞见”2017年保险业 2019-04-28
  • 楼市下半年或持续降温 房地产长效机制加速推进 2019-04-28
  • 为何越来越多的日本人开始找兼职? 2019-04-26
  • 人民网评:还老百姓蓝天白云、繁星闪烁 2019-04-26
  • 广州市第十五届人大常委会会议网络直播 2019-04-20
  • “西瓜足迹”瞎掰与“晒的虚荣” 2019-04-20
  • 习近平两会“典”亮新时代 2019-04-07
  • 中国足球,就是笑博士的“责权利平滑对接”改革的必然结果! 2019-04-03
  • 重庆高校陆续公布招生计划、专业设置情况和新政策 2019-04-03
  • 新时代 新气象 新作为 2019-03-30
  • 《中国地方志佛道教文献汇纂》——开辟佛道教研究新领域 2019-03-29
  • 拉萨市墨竹工卡县全力打造“绿色矿山” 2019-03-29
  • 批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
    [批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
    返回列表 发帖

    广东极客:[原创] [原创]vba生成商品条形码

    本帖最后由 happy886rr 于 2018-11-12 23:39 编辑
    【原创】不借助任何库,只用vba控制单元格颜色和宽窄,生成商品条码,扫描效果极佳,适合批量打印条码价签。
    效果图
     广东十一选五计划软件 www.qe-ar.com 
    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年用上了条码打印机,只能说相见恨晚。
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    TOP

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

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

    TOP

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

    回复 3# happy886rr
    厉害。
    条码打印机应该自带自动化的软件,包括图标插入、编排、序列自动递增等功能,按理说不用涉及到手写工具
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    TOP

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

    TOP

    回复 5# happy886rr

        嗖噶
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    TOP

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

    TOP

    回复 7# happy886rr


        我没买树莓派呀,只买过arduino nano,在淘宝。
    你要问的人是 bbaa 吧?他用树莓派在消遣区自动发帖。(可能是要做一个自动回帖机器人,好像最近不活跃了
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    TOP

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

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

    评分人数

    TOP

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

    TOP

    回复 10# happy886rr

    这都被你发现。
    最近颓废,沉迷游戏和漫画…… 没做什么东西出来。
    游戏在克制,但是《火凤燎原》真的很精彩。
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    TOP

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

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

    TOP

    回复 12# happy886rr


        我现在挺矛盾,但是又庆幸早几年没有沉迷虚度。
    (关于爬虫脚本耗电问题,我的脚本都在电脑跑,没有天天跑,电费不管他啦。)
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    TOP

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

    TOP

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

    回复 14# happy886rr

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

    这个网站扒起来很有成就感……
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    TOP

    返回列表
  • 让山里娃感受智慧科技乐趣 2019-05-19
  • 香港田径锦标赛飞人夺冠 2019-05-19
  • 诽谤侮辱英烈可追刑责 2019-05-14
  • 图解:十二字“洞见”2017年保险业 2019-04-28
  • 楼市下半年或持续降温 房地产长效机制加速推进 2019-04-28
  • 为何越来越多的日本人开始找兼职? 2019-04-26
  • 人民网评:还老百姓蓝天白云、繁星闪烁 2019-04-26
  • 广州市第十五届人大常委会会议网络直播 2019-04-20
  • “西瓜足迹”瞎掰与“晒的虚荣” 2019-04-20
  • 习近平两会“典”亮新时代 2019-04-07
  • 中国足球,就是笑博士的“责权利平滑对接”改革的必然结果! 2019-04-03
  • 重庆高校陆续公布招生计划、专业设置情况和新政策 2019-04-03
  • 新时代 新气象 新作为 2019-03-30
  • 《中国地方志佛道教文献汇纂》——开辟佛道教研究新领域 2019-03-29
  • 拉萨市墨竹工卡县全力打造“绿色矿山” 2019-03-29