VBA纯代码制作二维码 主要两部分,第一是保存Dll ,第二是调用核心模块 我的二维码.dll 把下面相应代码复制到相应模块 ,即可单个/或批量生成二维码 ‘把上面的dll保存,在VBA工具----引用界面引用该Dll,调用直接执行下面模块过程即可生成二维码(按A列数据生成二维码/可批量) Sub 清除() Dim pic As Shape With Sheet1 For Each pic In .Shapes If pic.Type = msoPicture Then pic.Delete '删除sheet1中所有二维码图片 Next pic End With End Sub '*********************重点再此************************************* Sub 二维码简化() Dim QR$, s$, ss$, i& Application.ScreenUpdating = False Call 清除 '执行程序,清除已有二维码 With Sheet1 For rrow = 2 To Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row If Range("a" & rrow) <> "" Then Call QRMain(Range("a" & rrow)) '生成二维码核心语句 Call CreateBitmapQRCode(RGB(0, 0, 0), RGB(255, 255, 255)) '设置二维码颜色 Call QRCodeToClipboard .Range("b" & rrow).Select '选中粘贴位置 .Rows(rrow).RowHeight = 93 '将粘贴图片的单元格调整尺寸,为了适合二维码放置 .Columns(2).ColumnWidth = 14.75 .Paste '粘贴剪切板内的图片 Application.CutCopyMode = False With Selection '图片是唯一的,设置图片:位置和大小 .ShapeRange.Height = Range("a" & rrow).Offset(0, 1).Height .ShapeRange.Width = Range("a" & rrow).Offset(0, 1).Width .ShapeRange.Left = Sheet1.Range("b" & rrow).Left + (Sheet1.Range("b" & rrow).Width - .Width) / 2 + 1 .ShapeRange.Top = Sheet1.Range("b" & rrow).Top + (Sheet1.Range("b" & rrow).Height - .Height) / 2 + 1 End With Else End If Next End With 'Call 拍照 Application.ScreenUpdating = True End Sub 本文来源:https://www.wddqw.com/doc/b67296ff930ef12d2af90242a8956bec0975a5a3.html