使用OFFICE自带控件在EXCEL中批量插入二维码以及条码-Toy模板网

这篇具有很好参考价值的文章主要介绍了使用OFFICE自带控件在EXCEL中批量插入二维码以及条码。希望对大家有所帮助。如果存在错误或未考虑完全的地方，请大家不吝赐教，您也可以点击"举报违法"按钮提交疑问。

经常在工作中我们需要在电子表格中插入二维码或者条码，在office早期直接下载条码字体就能解决问题，而在以后版本中需要 Microsoft BarCode Control （根据office版本不同有不同的版本）一般office的专业版都带有这个控件，如果没有可以自己下载安装。如果安装完成后可以按照以下的步骤完成条码或者二维码的批量生成。

1 如果生成单个二维码，按照下图打开开发工具菜单

使用OFFICE自带控件在EXCEL中批量插入二维码以及条码

再按照下图选择控件Microsoft BarCode Control 直接插入到相应的单元格，设置属性可以设置关联单元格或Value就可以生成二维码，可以通过修改属性，产生不同的编码。根据以往经验像批量生成二维码，将单元格向下拖拽时发现生成的二维码都是相同的值，说明对于控件而言这种简单的办法是没有办法批量生成二维码。

使用OFFICE自带控件在EXCEL中批量插入二维码以及条码

2批量生成二维码这时就需要借助VBA代码实现批量生成二维码

2.1第一步先在单元格中插入一个二维码不做任何设置

2.2将以下代码先拷贝到电子表格的VBA编辑器中

2.3再到开发工具中插入表单控件《按钮》选择与批量生成二维码函数关联，就可以再第二列生成第一列的二维码，如果有兴趣可将以下每个函数关联一个按钮，方便使用。二维码的大小可以修改以下函数中属性。以下的代码有注释，可以方便的根据自己需求进行修改。

Sub 清除()
Dim pic As Shape
With Sheet1
For Each pic In .Shapes
If pic.Type = 12 Then pic.Delete '删除sheet1中所有二维码图片'
Next pic
End With
End Sub

Sub 批量生成二维码()
Dim k As Long, i As Long
Call 清除
k = ActiveSheet.Range("A65536").End(xlUp).Row
For i = 1 To k
With ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1") '新增控件 '控件的属性
.Left = ActiveSheet.Cells(i, 1).Width + 2
.Top = ActiveSheet.Cells(i, 1).Top + 2
.Width = 70
.Height = 70 '链接的参数单元格
.Object.Style = 11 '二维码
.Object.ShowData = 1
.LinkedCell = "A" & i
End With
Next
End Sub
Sub 批量生成条形码()
Dim k As Long, i As Long
Call 清除
k = ActiveSheet.Range("A65536").End(xlUp).Row
For i = 1 To k
With ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1") '新增控件控件的属性'
.Left = ActiveSheet.Cells(i, 1).Width + 2
.Top = ActiveSheet.Cells(i, 1).Top + 2
.Width = 150
.Height = 50 '链接的参数单元格’
.Object.Style = 7
.Object.ShowData = 1
.LinkedCell = "A" & i
End With
Next
End Sub
Sub 导出二维码条形码()
Dim ad$, m&, mc$, shp As Shape
Dim nm$, n&, myFolder$
n = 0
myFolder = ThisWorkbook.Path & "\二维码图片\" '指定文件夹名称
For Each shp In ActiveSheet.Shapes
If shp.Type = 12 Then
If Len(Dir(myFolder, vbDirectory)) = 0 Then
MkDir myFolder
End If
n = n + 1
m = shp.TopLeftCell.Row
mc = Cells(m, 1) '
If code_name = "" Then
nm = mc & ".jpg" '图形对象的名字'
Else
nm = ActiveSheet.Cells(m, code_name) & ".jpg"
End If
shp.CopyPicture '将图形对象复制到剪切板'
With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart '在工作表中添加一个图表对象 '
.Parent.Select
.Paste '代码将剪切板中的图形对象以图片的格式粘贴到新添加的图表中
.Export myFolder & nm
.Parent.Delete '删除工作表中添加的图表对象'
End With
End If
Next
End Sub
文章来源地址https://www.toymoban.com/news/detail-462636.html