Excel自带控件批量生成条形码或二维码
▎具体需求
根据A列信息，批量生成二维码或者条形码。
▎思路分析
我们这里使用Excel自带的二维码条形码控件搭配VBA，实现批量生成的效果。
▎具体步骤
①由于二维码控件不是默认控件，需要单独找到添加。我们在开发工具中，找插入控件，选择【其他控件】 。
②找到我们需要的二维码条形码控件。点击，添加到表格中。绘制控件的时候，位置可以随意放置，因为后面批量生成的时候，代码还会对控件的位置重新布置。
③将以下代码放到模块中。
注意：生成二维码和条形码使用的都是这一个控件，只是通过其中一个参数Object.Style ，来控制生成的样式。
Sub 批量生成二维码()Dim k As Long, i As LongCall 清除k = ActiveSheet.Range("A65536").End(xlUp).RowFor i = 1 To kWith ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1") '新增控件'控件的属性.Left = ActiveSheet.Cells(i, 1).Width + 2.Top = ActiveSheet.Cells(i, 1).Top + 2.Width = 50.Height = 50'链接的参数单元格.Object.Style = 11 '二维码.Object.ShowData = 1.LinkedCell = "A" & iEnd WithNextEnd SubSub 批量生成条形码()Dim k As Long, i As LongCall 清除k = ActiveSheet.Range("A65536").End(xlUp).RowFor i = 1 To kWith 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" & iEnd WithNextEnd SubSub 清除()Dim pic As ShapeWith Sheet1For Each pic In .ShapesIf pic.Type = 12 Then pic.Delete '删除sheet1中所有二维码图片Next picEnd WithEnd SubSub 导出二维码条形码()Dim ad$, m&, mc$, shp As ShapeDim nm$, n&, myFolder$n = 0myFolder = ThisWorkbook.Path & "\二维码图片\" '指定文件夹名称For Each shp In ActiveSheet.ShapesIf shp.Type = 12 ThenIf Len(Dir(myFolder, vbDirectory)) = 0 ThenMkDir myFolderEnd Ifn = n + 1m = shp.TopLeftCell.Rowmc = Cells(m, 1)' If code_name = "" Thennm = mc & ".jpg" '图形对象的名字' Else' nm = ActiveSheet.Cells(m, code_name) & ".jpg"' End Ifshp.CopyPicture '将图形对象复制到剪切板With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart '在工作表中添加一个图表对象.Parent.Select.Paste '代码将剪切板中的图形对象以图片的格式粘贴到新添加的图表中.Export myFolder & nm.Parent.Delete '删除工作表中添加的图表对象End WithEnd IfNextEnd Sub
▎效果
批量生成二维码或条形码
导出二维码或条形码
评论