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