批量制作二维码

ctp_119

这段时间，稍微清闲一点，以前零零散散的知识，一直都没有整理，这几天刚好有这种欲望，于是就动手整理了。

用代码批量制作二维码大致有三种方法：

一：用MS Office2016自带控件BarCode制作(仅能识别字母和数字)；

二：用第三方QRmaker控件制作(默认状态下，仅能识别字母和数字，若要识别汉字，即支持中文，可以用自定义函数将中文转换为UTF8编码，然后用InputDateB属性值即可；

三：纯代码制作(全能型,无限制)

Barcode方法：

手工制作方法：

单击开发工具->插入->其他控件，在其他控件对话框中选Microsoft BarCode Control 16.0，单击确定按钮，

用鼠标在工作表中画出一个方框即可，如图所示：

剩下的事情，就是设置相关属性即可

右键单击控件->在弹出的快捷菜单中选中对象属性，在弹出的属性对话框中设置样式：11-QR Code，确定即可，其他可以不用设置。确定之后，就变为二维码形

式了，如下图所示：

右键单击控件，在弹出的快捷菜单中选属性，弹出属性对话框中设置LinkedCell

或Value的属性值即可，如下图：

手工制作完毕。

ctp_119

下面用代码批量生成二维码：

1. Sub 生成二维码()
   
2.     Dim Row As Integer
   
3.     Row = Range("A1").End(xlDown).Row
   
4.     For i = 1 To Row
   
5.         With ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1")
   
6.             .Left = Range("B1").Left
   
7.             .Top = Cells(i, 2).Top
   
8.             .Width = 100
   
9.             .Height = 100
   
10.             .Object.Style = 11   '这句代码是关键，设置样式成二维码，否则就是条形码
    
11.             .LinkedCell = "A" & i
    
12.             Cells(i, 2).ColumnWidth = .Width / 6.33
    
13.             Cells(i, 2).RowHeight = .Height
    
14.         End With
    
15.     Next
    
16. End Sub

复制代码

这个控件如何使用就介绍到这里，希望多加练习。

ctp_119

二、用QRmaker制作方法

因为这个控件是第三方控件，那就必须下载安装后，才可以使用。

下载就不必过多说了，输入QRmaker相关关键字下载即可，解压后如下图所示：

把其中的6个文件(或全部)复制粘贴到C:\Windows\System32(如果系统是64位的，复制粘贴到C:\Windows\SysWOW64)目录下面即可

接下来就是开始->运行，用regsvr32命令来安装，如下图：

如果是32位系统，路径稍作修改即可。

安装好后，后期绑定应该可以用了，如果是前期绑定还得做如下操作：

进入VBE编辑器，工具菜单->引用->浏览，找到刚才粘贴到的文件夹中，筛选出文件格式，找到QRmaker文件，打开即可，操作过程如下图：

注意：Qrmaker.lic 和Qrmaker.tlb文件仅仅在开发使用ActiveX控件的程序中使用。运行时不需要

前期工作就算结束了，接下来是如何使用它！

手工制作方法，和QR Code类似，剩下的都是属性的设置，不同的控件，属性不同。

ctp_119

下表中的属性都是生成二维码时需要配置的属性，用户可以自定义。其中几个关键的已经用黄颜色标明+

属性	类型	默认值	读/写	取值范围	定义
AutoRedraw	short	0	R/W	0/1	打开/关闭自动绘制模式
Bend	short	-1	R	>0	返回需要编码的字符串最后一个字符的位置
Bstart	short	0	R	>0	返回需要编码的字符串循环的开始位置
CellAdjust	short	0	R/W		设置一个单元纠正值，单位为dpi
CellPitch	short	(*)			以块中心为原点，设置块与块之间的距离。随着CellPitch的变化，CellAdjust也会发生相应的变化。
CellUnit	short	(*)	R/W	>1	设置打印机分辨率(in dpi)
ecclevel	short	1	r?w	0-3	设置纠错级别 0对应L等级(最大纠错率为：7%) 1对应M等级(最大纠错率为：15%) 2对应Q等级(最大纠错率为：25%) 3对应H等级(最大纠错率为：30%)
InputData			r/w		输入要编码的字符串
ModelNo	short	2	r/w	1-3	设置QR码的模式
numcell	short		r		返回创建的额QR码图像中每条边上的单元个数
picture			r		返回创建的二维码图片
QuietZone		5	r/w		设置二维码页边距（周围空白区域宽度）
Rotate	short	0	r.w	0-3	设置图片旋转角度(0,90.180,270)
TextOrBinary		0	r		返回当前编码模式，文本还是二进制

这个控件默认状态下是不支持中文的，于是为了支持中文，我可没少花时间来琢磨，最后找的了一段自定义函数代码，用上这个，万事大吉：

ctp_119

1. Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
   
2. Private Const CP_UTF8 = 65001
   
3. Public Function UTF8_Encode(ByVal strUnicode As String) As Byte()
   
4. 'UTF-8 编码
   
5.     Dim TLen As Long
   
6.     Dim lngBufferSize As Long
   
7.     Dim lngResult As Long
   
8.     Dim bytUtf8() As Byte
   
9.       
   
10.     TLen = Len(strUnicode)
    
11.     If TLen = 0 Then Exit Function
    
12.       
    
13.     lngBufferSize = TLen * 3 + 1
    
14.     ReDim bytUtf8(lngBufferSize - 1)
    
15.       
    
16.     lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)
    
17.       
    
18.     If lngResult <> 0 Then
    
19.         lngResult = lngResult - 1
    
20.         ReDim Preserve bytUtf8(lngResult)
    
21.     End If
    
22.       
    
23.     UTF8_Encode = bytUtf8
    
24. End Function

复制代码

ctp_119

下面是在Excel用该控件制作的支持中文的二维码，如下图

ctp_119

源码如下：

1. Sub 二维码制作()
   
2. Dim i As Integer
   
3. Dim qr As Object
   
4. Dim qn As String
   
5. Dim shp As Object
   
6. For Each shp In ActiveSheet.Shapes
   
7.     If VBA.Left(shp.Name, 7) = "QRmaker" Then
   
8.         shp.Delete
   
9.     End If
   
10. Next
    
11. For i = 2 To Range("A65536").End(xlUp).Row
    
12.     Set qr = Application.ActiveSheet.OLEObjects.Add(ClassType:="QRMAKER.QRmakerCtrl.1", Top:=Cells(i, 2).Top, Left:=Cells(i, 2).Left, Height:=Cells(i, 2).Height - 2, Width:=Cells(i, 2).Width - 2, Link:=False, DisplayAsIcon:=False)
    
13.     qr.Name = "QRmaker" & i
    
14.     qn = qr.Name
    
15.     With ActiveSheet.OLEObjects(qn).Object
    
16.         .ModelNo = 2
    
17.         .CellPitch = 20
    
18.         .CellUnit = 200
    
19.         .QuietZone = 0
    
20.         .InputDataB = UTF8_Encode(Cells(i, 1).Value) '转为UTF8编码输入可以处理中文
    
21.         .AutoRedraw = ArOn
    
22.         .Refresh
    
23.     End With
    
24. Next i
    
25. End Sub

复制代码

ctp_119

第三种方法，我就不发了，都在附件中，想学习的下载附件：


QRMaker控件.rar (1.36 MB, 下载次数: 116)

2023-2-25 15:43 上传

点击文件名下载附件

二维码制作.rar (1.23 MB, 下载次数: 133)

2023-2-25 15:45 上传

点击文件名下载附件

ivccav

我认为谷歌的开源项目zxing已足够好，速度足够快，支持几十种条码和二维码的生成和识别，不仅仅是QR二维码。

blackttea1

学习啦，谢谢