vba 二维码生成

Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Point01 As Long, Point02 As Long, Point03 As Long
Private i As Integer

Sub MakeQRCode()
    Dim path As String
    path = ThisWorkbook.path & "\QR.exe"
    If Dir(path) = "" Then
        MsgBox "QRmake.exe文件丢失，请确认！", vbCritical, "外部程序调用"
        Exit Sub
    End If
    i = MK_QR("ah@###00510210325####PC#P#G54ABC001#", "100", "20")   '中间数字, 最后数字跳转大小.
End Sub

Function MK_QR(Enc_Dat, ECL, SIZ)
    Dim F_Name As String
    Dim path As String
    F_Name = "[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name & "!" & ActiveCell.Address
    path = ThisWorkbook.path & "\QR.exe"
    Point01 = Shell("""" & path & Chr(34) & " /S" & SIZ & " /L" & ECL + 1 & " /O""" & ThisWorkbook.path & "\" & F_Name & ".bmp"" /T""" & Enc_Dat & """")
    Point02 = OpenProcess(&H100000, 1, Point01)
    Point03 = WaitForSingleObject(Point02, &HFFFFFFFF)
    Point03 = CloseHandle(Point02)
    Point01 = Empty
    Point02 = Empty
    Point03 = Empty
    Cells(9, 4).Select
    With ActiveSheet.Pictures.Insert(ThisWorkbook.path & "\" & F_Name & ".bmp")
        .Left = ActiveCell.Left
        .Top = ActiveCell.Top
    End With
    '将已经生成的二维码图像删除
    Kill (ThisWorkbook.path & "\" & F_Name & ".bmp")
    ActiveCell.Offset(0, -1).Select
End Function