批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

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

本帖最后由 happy886rr 于 2018-11-12 23:39 编辑
【原创】不借助任何库,只用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

评分人数

本帖最后由 yu2n 于 2019-5-26 13:20 编辑

算法厉害!

我目前是这样使用条形码、二维码的:

1. 条形码使用专用的条形码字体(Barcode Font),简单高效。
例如:橫條形碼使用 BC C39 3 to 1 HD Wide ,豎條形碼使用 BC C39 2 to 1 HD Medium 。

2. 二维码直接用开源库生成。
例如: Quricol - QR code generator library 。
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

回复 1# happy886rr
谢谢楼主的无私分享!
您的这个激发了我的进一步学习,但是,由于功力尚浅,楼主是否可以将您这个功能直接弄一个EXCEL文件发上来,这样,我们就可以直观的体验学习了,再通过其中的VBA代码学习利用。
谢谢!

   

TOP

回复 19# 极品小猫

   感谢 ,我又加了-tile 1x99参数 和改调整大小为100原始尺寸
   其实我的初衷是楼主挺会写第三方命令行,要是能有个更简单版的合并分割长图片命令行会更方便
   不过这个ImageMagick也挺好,就是图片多时处理速度略微有点慢,命令过多,不好记,基本就得翻命令帮助和网上各种例子
   一开始我也没打算发帖问这个功能,不过看到楼主发贴,突然又想起这个了,然后就……

TOP

大侠,有没有命令行的图片连接成手机长截图那种效果的工具
siang 发表于 2018-11-13 11:14


提问最好去发表新帖,不要搭车
http://bcn.bathome.net/tool/ImageMagick,7.0.7-30/montage.exe
http://bcn.bathome.net/tool/ImageMagick,7.0.7-30/montage64.exe

可以使用蒙太奇命令进行图像复合,用法
  1. montage64 1.png 2.png -geometry +10+10 -resize 50% 3.png
复制代码
用法:1.png、2.png 是素材,-geometry 不使用会变成缩略图,-resize 25%重设复合后的图像大小,3.png 为输出文件

    其它参数作用请自查

TOP

大侠,有没有命令行的图片连接成手机长截图那种效果的工具

TOP

回复 15# 523066680


    这车很6啊,脚本耗电,如果电费可观的话不是应该买个云服务器来跑脚本更划算么?

TOP

回复 15# 523066680
搜嘎,好东西收藏了。

TOP

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

回复 14# happy886rr

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

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

TOP

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

TOP

回复 12# happy886rr


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

TOP

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

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

TOP

回复 10# happy886rr

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

TOP

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

TOP

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

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

评分人数

TOP

返回列表