VBA纯代码制作二维码
●主要两部分，第一是保存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

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。