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

您所在的位置:网站首页 无锡锡山区吴莉萍 使用OFFICE自带控件在EXCEL中批量插入二维码以及条码

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

2024-06-06 05:40| 来源: 网络整理| 查看: 265

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

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

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



【本文地址】


今日新闻


推荐新闻


CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3