[原创]vba生成商品条形码(页 1) - VBS原创&转载 - 批处理之家 BAT,CMD,批处理,PowerShell,VBS,DOS

happy886rr 发表于 2018-11-12 23:32

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

[quote]【原创】不借助任何库，只用vba控制单元格颜色和宽窄，生成商品条码，扫描效果极佳，适合批量打印条码价签。
[/quote][code]'计算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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
[/code]

523066680 发表于 2018-11-13 08:29

[i=s] 本帖最后由 523066680 于 2018-11-13 08:32 编辑 [/i]

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

happy886rr 发表于 2018-11-13 08:50

[i=s] 本帖最后由 happy886rr 于 2018-11-13 08:52 编辑 [/i]

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214817&ptid=51286]2#[/url] [i]523066680[/i] [/b]
我有4台TSC 244pro，用自己写的工具去驱动TSC批量打。就是碳带费点。

523066680 发表于 2018-11-13 08:52

[i=s] 本帖最后由 523066680 于 2018-11-13 08:54 编辑 [/i]

[b]回复 [url=http://bbs.bathome.net/redirect.php?goto=findpost&pid=214818&ptid=51286]3#[/url] [i]happy886rr[/i] [/b]
厉害。
条码打印机应该自带自动化的软件，包括图标插入、编排、序列自动递增等功能，按理说不用涉及到手写工具

happy886rr 发表于 2018-11-13 08:54

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214819&ptid=51286]4#[/url] [i]523066680[/i] [/b]
有，但是不能自己随心所欲设计。我可以自己写代码，做出各种码式，加艺术字。甚至创建自己定义的条码，然后用zxing库创建手机app扫描自己定义的新式条形码。

523066680 发表于 2018-11-13 08:55

[b]回复 [url=http://bbs.bathome.net/redirect.php?goto=findpost&pid=214820&ptid=51286]5#[/url] [i]happy886rr[/i] [/b]

嗖噶

happy886rr 发表于 2018-11-13 09:00

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214822&ptid=51286]6#[/url] [i]523066680[/i] [/b]
你的树莓派在哪买的

523066680 发表于 2018-11-13 09:01

[b]回复 [url=http://bbs.bathome.net/redirect.php?goto=findpost&pid=214823&ptid=51286]7#[/url] [i]happy886rr[/i] [/b]

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

happy886rr 发表于 2018-11-13 09:03

[i=s] 本帖最后由 happy886rr 于 2018-11-13 09:07 编辑 [/i]

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214824&ptid=51286]8#[/url] [i]523066680[/i] [/b]
用电脑运行太费电，还是小型arm机比较划算，搭建各种迷你云。

happy886rr 发表于 2018-11-13 09:08

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214824&ptid=51286]8#[/url] [i]523066680[/i] [/b]
你在论坛待十年了，今年是你十周年坛龄。

523066680 发表于 2018-11-13 09:15

[b]回复 [url=http://bbs.bathome.net/redirect.php?goto=findpost&pid=214826&ptid=51286]10#[/url] [i]happy886rr[/i] [/b]

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

happy886rr 发表于 2018-11-13 09:19

[i=s] 本帖最后由 happy886rr 于 2018-11-13 09:23 编辑 [/i]

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214827&ptid=51286]11#[/url] [i]523066680[/i] [/b]
国漫也不错，你可以看看不良人动画挺精彩，还有那个换世门生里边的念阳枭颇像你。游戏我也天天玩，每天3小时CF
我就是念阳枭[img]https://gss0.bdstatic.com/-4o3dSag_xI4khGkpoWK1HF6hhy/baike/c0%3Dbaike150%2C5%2C5%2C150%2C50/sign=e2d2b54ca7af2eddc0fc41bbec796a8c/bd315c6034a85edf196a356942540923dc547592.jpg[/img]

523066680 发表于 2018-11-13 09:23

[b]回复 [url=http://bbs.bathome.net/redirect.php?goto=findpost&pid=214828&ptid=51286]12#[/url] [i]happy886rr[/i] [/b]

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

happy886rr 发表于 2018-11-13 09:24

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214829&ptid=51286]13#[/url] [i]523066680[/i] [/b]
就是12楼的那个图

523066680 发表于 2018-11-13 09:27

[i=s] 本帖最后由 523066680 于 2018-11-17 15:29 编辑 [/i]

[b]回复 [url=http://bbs.bathome.net/redirect.php?goto=findpost&pid=214830&ptid=51286]14#[/url] [i]happy886rr[/i] [/b]

叼炸了。
说道爬图片，悄悄发个链接 [url=https://www.elitebabes][color=White].com/model/Sloan-Kendricks/[/color][/url]
后面有人的话请勿打开

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

happy886rr 发表于 2018-11-13 09:33

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214831&ptid=51286]15#[/url] [i]523066680[/i] [/b]
搜嘎，好东西收藏了。

极品小猫 发表于 2018-11-13 10:04

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214831&ptid=51286]15#[/url] [i]523066680[/i] [/b]

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

siang 发表于 2018-11-13 11:14

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

极品小猫 发表于 2018-11-13 12:14

[quote]大侠，有没有命令行的图片连接成手机长截图那种效果的工具
[size=2][color=#999999]siang 发表于 2018-11-13 11:14[/color] [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214835&ptid=51286][img]http://www.bathome.net/images/common/back.gif[/img][/url][/size][/quote]

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

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

其它参数作用请自查

siang 发表于 2018-11-14 01:15

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214836&ptid=51286]19#[/url] [i]极品小猫[/i] [/b]

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

locoman 发表于 2019-2-14 15:58

[b]回复 [url=http://www.bathome.net/redirect.php?goto=findpost&pid=214812&ptid=51286]1#[/url] [i]happy886rr[/i] [/b]
[size=5]谢谢楼主的无私分享！
您的这个激发了我的进一步学习，但是，由于功力尚浅，楼主是否可以将您这个功能直接弄一个EXCEL文件发上来，这样，我们就可以直观的体验学习了，再通过其中的VBA代码学习利用。
谢谢！

[/size]

yu2n 发表于 2019-5-26 13:09

[i=s] 本帖最后由 yu2n 于 2019-5-26 13:20 编辑 [/i]

算法厉害！

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

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

2. 二维码直接用开源库生成。
例如： Quricol - QR code generator library 。

页: [1]

批处理之家's Archiver

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