首页 文章详情

Excel自带控件批量生成条形码或二维码

VBA说 | 3394 2021-05-26 00:01 0 0 0
UniSMS (合一短信)

▎具体需求


根据A列信息,批量生成二维码或者条形码。






▎思路分析


我们这里使用Excel自带的二维码条形码控件搭配VBA,实现批量生成的效果。



▎具体步骤


①由于二维码控件不是默认控件,需要单独找到添加。我们在开发工具中,找插入控件,选择【其他控件】 。





②找到我们需要的二维码条形码控件。点击,添加到表格中。绘制控件的时候,位置可以随意放置,因为后面批量生成的时候,代码还会对控件的位置重新布置。












③将以下代码放到模块中。

注意:生成二维码和条形码使用的都是这一个控件,只是通过其中一个参数Object.Style ,来控制生成的样式。



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 = 50            .Height = 50            '链接的参数单元格            .Object.Style = 11 '二维码            .Object.ShowData = 1            .LinkedCell = "A" & i        End With    NextEnd 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 NextEnd SubSub 清除() Dim pic As Shape With Sheet1 For Each pic In .Shapes If pic.Type = 12 Then pic.Delete '删除sheet1中所有二维码图片 Next pic End WithEnd SubSub 导出二维码条形码() 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 NextEnd Sub




▎效果


  • 批量生成二维码或条形码




  • 导出二维码或条形码









推荐阅读:(点击下方标题即可跳转)


good-icon 0
favorite-icon 0
收藏
回复数量: 0
    暂无评论~~
    Ctrl+Enter