批量生成二維碼

Excel

批量生成二維碼

---

在工作中，一般生成二維碼有常用的二維碼生成器。一些在線二維碼生成工具有很多。批量生成二維碼，用的人必然知道他的大用處，但是二維碼生成工具中，批量生成這個基本都是收費功能。

前兩天了解到可以用vba批量生成二維碼，研究了一下，借鑑了部分其他人的源碼，做出來了一個簡單的批量生成二維碼的小工具。

➜效果如下：

用微信掃一掃其中一張二維碼就會出現以下內容：

是不是很神奇？

接下來講一下實現方法

➜目前，excel vba實現生成二維碼主要有兩種方式：1.引用QRmaker.ocx控制項實現2.代碼實現 

但是，方法1有一些缺點：當換了1臺電腦時或發給其它人用時，電腦中沒有二維【QRmaker.ocx】控制項就不能用了，需要在網上下載二維碼【QRmaker.ocx】控制項並註冊控制項才能用；還有不適配64位office。

為了以後方便，將二維碼【QRmaker.ocx】控制項生成二維碼的功能，用純VBA代碼做就不在需要依賴二維碼【QRmaker.ocx】控制項了

在論壇裡尋找了幾乎所有的二維碼帖子，找到一個可以利用的。經過改造，文章開頭的效果就出來了。

這三個核心模塊不要動，只需要修改模塊：生成二維碼模塊裡面的內容為自己需要的即可。

生成二維碼模塊代碼：

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 = 90  '將粘貼圖片的單元格調整尺寸，為了適合二維碼放置

            .Columns(2).ColumnWidth = 15

            .Paste  '粘貼剪切板內的圖片

            Application.CutCopyMode = False

            With Selection       '圖片是唯一的,設置圖片：位置和大小

                .ShapeRange.Height = 80

                .ShapeRange.Width = 80

                .ShapeRange.Left = Sheet1.Range("b" & rrow).Left + (Sheet1.Range("b" & rrow).Width - .Width) / 2

                .ShapeRange.Top = Sheet1.Range("b" & rrow).Top + (Sheet1.Range("b" & rrow).Height - .Height) / 2

            End With

            Else

            End If

        Next

    End With

    Application.ScreenUpdating = True

    MsgBox "完成"

End Sub

生成二維碼以後，還可以將二維碼批量另存圖片到文件夾，這裡涉及到shapes對象的應用。下次分享再具體說。