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
标签:ThisWorkbook,Function,vba,Name,ByVal,Long,生成,二维码,path From: https://www.cnblogs.com/pythonClub/p/17533083.html