VBA 二维码、条形码的批量生成与识别技术

ivccav · 发表于 2021-3-13 21:26

本帖最后由 ivccav 于 2021-3-14 09:22 编辑

现在条形码、二维码越来越火，且已应用到社会生活中的方方面面。
不少人在工作中为高效的管理设备、文件和物料，也有使用条码的需求。

搜了一下论坛，提供二维码生成控件的帖子真不少。记得有一帖是用VBA
语音生成二维码，真的很强大，可惜只是一个技术原型，网友使用中发现有
2-3%的条码无法识别，应该存在bug，且没有识别二维码的模块，而稍微能
应用于实际的二维码控件，基本全部都是以注册收费的形式提供。

今天中午看到论坛有人求价格便宜的生成data matrix二维码的控件，说网上
都是要价千元以上的。于是就想要介绍一个永久免费、开源的条码生产工具，该
工具是ZXing.Net，有人测评过，是目前最高效的二维码开源项目，支持VBA语言，
且能高效生成和识别各种条形码，足够满足普通使用者的需求了。支持的格式如下：

因为没有官方文档，只能根据可能的实际遇到的应用做几个示例，当抛砖引玉吧！
主要示例如下：

0.ZXing.Net的官方下载（本帖也提供下载）
1.生成二维码并放进系统剪贴板供使用
2.批量生成二维码并插入到指定单元格
3.生成二维码并导出为各种文件
4.生成条形码并导出为各种文件
5.二维码图片文件的识别示例
6.在窗体中生成并显示二维码
7.批量给二维码中间添加Logo

程序文件和示例代码.zip (731.18 KB, 下载次数: 1389)

ivccav · 发表于 2023-2-2 09:34

本帖最后由 ivccav 于 2023-2-2 14:12 编辑

interop.zip (651.37 KB, 下载次数: 201)

纯代码生成二维码（32 & 64 bit）.zip (232.41 KB, 下载次数: 230)

interop C#源代码.zip (31.51 KB, 下载次数: 94)

ivccav · 发表于 2021-3-13 21:44

第一步：下载与安装ZXing.Net

1.复制上面附件中的ZXING.NET文件夹到系统盘Windows目录下（也可以不用这么做，放在电脑哪个地方都可以，找得到就行）
ZXING.NET官方github下载地址也在附件使用说明的记事本中。

2.选中register文件，右键——以管理员身份运行，这个非常重要！！！

管理员身份.png

3.注册成功后，在Excel VBE界面引用zxing.interop.tlb即可。

注册成功.png

（如果勾选“信任对于‘Visual Basic项目’的访问”，在工具——宏——安全性——可靠发行商中设置，可以运行代码：
ThisWorkbook.VBProject.References.AddFromGuid "{ECE3AB74-9DD1-4CFB-9D48-FCBFB30E06D6}", 0, 16
这样即可引用ZXing.NET了！

未注册成功的朋友，还得耐心看一下这里：

注册未成功.png

4.如果没有安装过office 2010以上的系统，可能没有Microsoft .NET Framework 4.5，版本太低是安装不成功的，
需先下载安装，49Mb的小文件。官方下载：

https://www.microsoft.com/zh-cn/download/details.aspx?id=30653

或者点这里下载在线安装（微软官方的）：

dotNetFx45_Full_setup.zip (883.18 KB, 下载次数: 127)

安装成功之后再次以管理员身份运行运行register文件。

补充内容 (2023-2-2 09:09):
ZXing.Net下载地址：

https://github.com/micjahn/ZXing.Net

ivccav · 发表于 2021-3-13 22:24

2.生成QR二维码并导出为文件

Function Encode_To_QR_Code_To_File()
Dim Writer As IBarcodeWriter
Dim qrCodeOptions As QrCodeEncodingOptions
Set qrCodeOptions = New QrCodeEncodingOptions
Set Writer = New BarcodeWriter
Writer.Format = BarcodeFormat_QR_CODE
Set Writer.Options = qrCodeOptions
Rem 尺寸单位：像素
qrCodeOptions.Height = 200
qrCodeOptions.Width = 200
qrCodeOptions.Margin = 10
qrCodeOptions.CharacterSet = "UTF-8"
qrCodeOptions.ErrorCorrection = ErrorCorrectionLevel_H
Writer.WriteToFile Sheet2.[A1], ThisWorkbook.path & "\test.png", ImageFileFormat_Png
End Function

复制代码

QRCode，即 Quick Response Code，快速响应码，为丰田旗下的电装(DENSO)公司发明，
其特点是容量大（能容纳数千个字符，汉字能容纳1800多个），扫描识别快，所以应用
最为广泛，工作、生活中到处都是QR二维码。

QR二维码使用QrCodeEncodingOptions设置参数。

a.如果要支持汉字，请选UTF-8字符集。

b.二维码容错率等级分为：L、M、Q、H四级，
Level L – 7%损毁还能被识别
Level M – 15%损毁还能被识别
Level Q – 25%损毁还能被识别
Level H – 30%损毁还能被识别

等级越高，抗污损的能力越强，扫描识别也越快，但容纳的字符就更少。

c.高度Height和宽度Width根据内容多寡合理设置，单位为像素。白边Margin设置没什么用。
早期版本根本没这个参数。程序会根据内容长度计算二维码的版本。二维码一共有40个尺寸规格，
专业叫法叫版本Version。Version 1是21 x 21的矩阵，Version 2是 25 x 25的矩阵，
每增加一级version，就会增加4的尺寸，公式是：(V-1)*4 + 21（V是版本号）最高Version 40，
(40-1)*4+21 = 177，所以最高是177 x 177 的正方形。程序会根据内容长度选择最小的版本。
现在我们假设要生成一个 200x200像素的二维码图片，若版本为 40，即二维码矩阵为 177x177，
那么，剩下的23x23就需要白边来填充；而如果程序计算出版本为2，因为二维码矩阵为 25x25,
放大8倍时正好 200x200，白边就不会剩余。Margin参数随便设置为1到5就行了。

d.导出的文件格式支持：bmp，gif，jpeg，png，tiff和wmf

ivccav · 发表于 2021-3-13 22:32

3.批量生成二维码并插入到指定单元格，二维码放进系统剪贴板

可以利用BarcodeWriter对象GetStdPicture方法获取StdPicture图片对象，
然后放进剪贴板，然后粘贴到Excel表的单元格中，而无需使用Pictures.Insert
从磁盘文件中重新导入到Excel。

Rem 生成二维码并转为StdPicture对象
Function Encode_To_QR_Code(cont As String) As IPictureDisp
Dim Writer As IBarcodeWriter
Dim qrCodeOptions As QrCodeEncodingOptions
Set qrCodeOptions = New QrCodeEncodingOptions
Set Writer = New BarcodeWriter
Writer.Format = BarcodeFormat_QR_CODE
Set Writer.Options = qrCodeOptions
qrCodeOptions.Height = 200
qrCodeOptions.Width = 200
qrCodeOptions.Margin = 5
qrCodeOptions.CharacterSet = "UTF-8"
qrCodeOptions.ErrorCorrection = ErrorCorrectionLevel_H
Set Encode_To_QR_Code = Writer.GetStdPicture(cont)
End Function

复制代码

#If VBA7 Then
Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal Format As Long, ByVal hMem As LongPtr) As Long
Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
#Else
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SetClipboardData Lib "user32" (ByVal Format As Long, ByVal hMem As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
#End If
Const CF_BITMAP = 2&
Rem 把图片放进剪贴板
Function SetClipboard(cont As String) As Boolean
Dim hwnd As LongPtr
On Error GoTo ErrHandler
hwnd = 0
If OpenClipboard(hwnd) Then
EmptyClipboard
SetClipboardData CF_BITMAP, Encode_To_QR_Code(cont)
CloseClipboard
SetClipboard = True
Exit Function
End If
ErrHandler: SetClipboard = False
End Function

复制代码

Rem 批量生成QR二维码并插入指定单元格
Sub MakeQRCode()
Dim Rng As Range, Shp As Shape, r&
Application.ScreenUpdating = False
r = Range("a" & Rows.Count).End(3).Row
For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoPicture Then Shp.Delete
Next
For Each Rng In Range("a1:a" & r)
If SetClipboard(Rng.Value) Then
ActiveSheet.Paste Rng.Offset(, 2)
With Selection.ShapeRange
.LockAspectRatio = msoTrue
.Top = Rng.Offset(, 2).Top + 2
.Left = Rng.Offset(, 2).Left + 2
.Height = Rng.Offset(, 2).Height - 4
End With
End If
Next
Application.ScreenUpdating = True
End Sub

复制代码

ivccav · 发表于 2021-3-13 22:42

4.再举例：Code128条形码和Datamatrix二维码

Rem 生成条形码并导出为图片文件
Rem 128码：可表示从ASCII 0 到ASCII 127 共128个字符，故称
Function Encode_To_CODE_128_To_File()
Dim EnCodeOptions As New EncodingOptions
Dim Writer As IBarcodeWriter
Set Writer = New BarcodeWriter
Writer.Format = BarcodeFormat_CODE_128
Set Writer.Options = EnCodeOptions
EnCodeOptions.Height = 50
EnCodeOptions.Width = 200
EnCodeOptions.Margin = 2
Writer.WriteToFile "hello world!", ThisWorkbook.path & "\test.png", ImageFileFormat_Png
End Function

复制代码

条形码用EncodingOptions设置参数，要设置好条码格式：

条码格式.png

“Hello World”的条形码效果如下：

hello world条码.png

Rem 生成DATA MATRIX 二维码
Function Encode_To_DM_Code_To_File()
Dim Writer As IBarcodeWriter, cont As String
Dim DMCodeOptions As New DatamatrixEncodingOptions
Set Writer = New BarcodeWriter
cont = "{ECE3AB74-9DD1-4CFB-9D48-FCBFB30E06D6}"
Writer.Format = BarcodeFormat_DATA_MATRIX
Set Writer.Options = DMCodeOptions
DMCodeOptions.Height = 200
DMCodeOptions.Width = 200
DMCodeOptions.Margin = 5
DMCodeOptions.SymbolShape = SymbolShapeHint_FORCE_SQUARE
Writer.WriteToFile cont, "D:\test.png", ImageFileFormat_Png
End Function

复制代码

DATA MATRIX 二维码使用DatamatrixEncodingOptions设置参数，注意ymbolShape的选择。
字符串{ECE3AB74-9DD1-4CFB-9D48-FCBFB30E06D6}的DM码效果如下：

ivccav · 发表于 2021-3-13 22:51

5.二维码图片的识别

Rem 读取图片文件数据进行解码
Function Decode_QR_Code_From_File()
Dim Reader As IBarcodeReader
Dim Res As Result
Set Reader = New BarcodeReader
Reader.Options.PossibleFormats.Add BarcodeFormat_QR_CODE
Set Res = Reader.DecodeImageFile(ThisWorkbook.path & "\test.png")
Debug.Print Res.Text
End Function
Rem 从Byte数组数据进行二维码解码
Function Decode_QR_Code_From_Byte_Array()
Dim Reader As IBarcodeReader
Dim rawRGB(1000) As Byte
Dim Res As Result
Set Reader = New BarcodeReader
Reader.Options.PossibleFormats.Add BarcodeFormat_QR_CODE
Rem TODO: load bitmap data to byte array rawRGB
Set Res = Reader.DecodeImageBytes(rawRGB, 10, 10, BitmapFormat.BitmapFormat_Gray8)
End Function

复制代码

6.给二维码添加Logo

二维码程序本身是不能添加Logo的，但利用二维码容错率原理，在生成的二维码图片中添加一张较小的
图片，只要遮挡的面积在容错率范围内，二维码就能被识别。一般Logo图片的尺寸取二维码尺寸的20%以下为宜。

Rem 批量给图片添加Logo
Sub addlogo()
Dim logo As Object, img As Object, ip As Object
Dim path As String, filename As String, i As Long
On Error Resume Next
Set img = CreateObject("wia.imagefile")
Set logo = CreateObject("wia.imagefile")
Set ip = CreateObject("wia.imageprocess")
path = ThisWorkbook.path & Application.PathSeparator
logo.LoadFile path & "logo.png"
ip.Filters.Add ip.FilterInfos("Stamp").FilterID
Set ip.Filters(1).Properties("ImageFile") = logo
filename = Dir(path & "*.png")
Do While Len(filename)
If filename <> "Logo.png" Then
img.LoadFile path & filename
ip.Filters(1).Properties("Left") = (img.Width - logo.Width) / 2
ip.Filters(1).Properties("Top") = (img.Height - logo.Height) / 2
Set img = ip.Apply(img)
i = i + 1
Kill path & "Result\result_" & i & ".png"
img.SaveFile path & "result\result_" & i & ".png"
End If
filename = Dir
Loop
MsgBox "处理完成的图片在Result文件夹中！"
End Sub

复制代码

完整示例和代码见1楼的附件。

添加Logo后的效果

ivccav · 发表于 2021-3-13 23:04

总结：

在Windows7 64bit 和 Windows10 64bit 系统上，用WPS 2019完美运行ZXing.Net。
如果是Windows7系统，未安装office 2010以上版本，Microsoft .NET Framework 版本为2，
版本太低会注册不成功ZXing.DLL，可以安装Office2010以上版本，或者下载一个49MB的
Microsoft .NET Framework 4.5安装再注册。其他环境未模拟测试过。

ZXing.Net是一个基于.Net平台的二维码工具，支持大多数主流条码和二维码的生产和识别，
同时支持C#、VBA等多种编程语言，高效、免费开源，值得使用。

aman1516 · 发表于 2021-3-13 23:24

谢谢分享，支持原创

aecn · 发表于 2021-3-14 00:30

感谢ivccav老师的重磅分享

morpheus126 · 发表于 2021-3-14 01:16

感谢分享，收藏学习！

		自动登录	找回密码
密码			免费注册

[原创] VBA 二维码、条形码的批量生成与识别技术

评分

评分