利用控件生成二维码

Sub 生成二维码()
    Dim wb As Workbook
    Dim sht As Worksheet
    Set wb = Application.ThisWorkbook
    Set sht = wb.Worksheets(1)
    'Randomize
    With sht
        '删除旧条码控件
        .Shapes.SelectAll
        Selection.Delete
        For i = 2 To 20
            ' .Cells(i, 1) = i - 1
            '.Cells(i, 2) = "NO." & Format(Now(), "YYYYMMDDHHMMSS") & "A" & Format(Int((10000 - 1 + 1) * Rnd + 1), "0000")
            Set obj = ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1")  '新增控件
            With obj
                .Left = ActiveSheet.Cells(i, 3).Left + 2                          '控件的属性
                .Top = ActiveSheet.Cells(i, 3).Top + 2
                .Width = 50
                .Height = 50
                .Object.Style = 11 '二维码
                .Object.ShowData = 1
                .Object.Value = Cells(i, "B").Value
                .Name = i
                .Select
                'Sht.Shapes.Item(obj.Name).CopyPicture
                Selection.CopyPicture
                sht.Cells(i, 4).Select
                sht.PasteSpecial Format:="图片(png)", Link:=False, DisplayAsIcon:=False
                .Delete
            End With
            DoEvents
        Next i
    End With
End Sub