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

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

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

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

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