excel数据生成条码或者二维码并放在表格中（VBA）

最近做的项目要将一列数据生成条码和二维码，并打印
这是一个简单的表格操作嵌入式脚本目的是生成二维码或条码
直接上代码

Sub 批量生成二维码()

 Dim k As Long, i As Long, j As Long, l As Long, m As Long, n As Long

 Call 清除

 k = ActiveSheet.Range("A65536").End(xlUp).Row

 For i = 1 To k

 With ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1") '新增控件

 '控件的属性 ActiveSheet.Cells(i, 1).Width + 2

 If i > 5 Then

  j = i \ 5

   l = i Mod 5

    If l = 0 Then

        .Top = 203.4

    Else

    

        .Top = (l - 1) * 50.4 + 1.8

    End If

    If l = 0 Then

        .Left = j * 60

        Else

  .Left = (j + 1) * 60

  End If

  Else

  .Top = (i - 1) * 50.4 + 1.8

 .Left = 60

 End If

 

 .Width = 50

 .Height = 50

 '链接的参数单元格

 .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 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 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

我这边使用的是office16版本的excel
控件使用方法：
新建表格->开发工具->插入->其他控件-从下拉框找到
Microsoft BarCode Control 16.0
代码使用方法：
新建表格->开发工具Visual Basic 在Sheet1双击在弹框中复制代码如下图

运行效果图

有部分借鉴其他人的代码如有侵权请联系删除