VBA纯代码制作二维码

时间:2022-07-08 06:10:17 阅读: 最新文章 文档下载
说明:文章内容仅供预览,部分内容可能不全。下载后的文档,内容与下面显示的完全一致。下载之前请确认下面内容是否您想要的,是否完整无缺。
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