[vba] [vba] Excel에서 QR Code 사용하기
하나를하더라도최선을
2019-09-29 20:13
7,486
0
-
- 첨부파일 : QR Code.xlsm (20.9K) - 다운로드
본문
Private Sub Worksheet_Change(ByVal C As Range)
If C.Address(0, 0) <> "C2" Then End
Dim URL As String, B() As Byte
URL = URL & "data=" & [value]
Dim pic As Picture
For Each pic In Me.Pictures
If pic.Name = "QRCODE" Then pic.Delete
Next
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", URL
.SetRequestHeader "Host", "api.qrserver.com"
.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:56.0) Gecko/20100101 Firefox/56.0"
.SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
.SetRequestHeader "Accept-Language", "ko-KR,ko;q=0.8,en-US;q=0.5,en;q=0.3"
.SetRequestHeader "Connection", "keep-alive"
.SetRequestHeader "Upgrade-Insecure-Requests", "1"
.SetRequestHeader "Cache-Control", "max-age=0"
.Send
.WaitForResponse: DoEvents
B = .ResponseBody
End With
Dim fPath As String
fPath = ThisWorkbook.Path & "\QRCode.jpg"
WriteBinaryFile fPath, B
Set C = C.Offset(1).Resize(8)
With ActiveSheet.Shapes.AddPicture(fPath, msoFalse, msoTrue, C.Left + 2, C.Top + 2, C.Width - 4, C.Width - 4)
.Name = "QRCODE"
End With
If Len(fPath) Then Kill fPath
End Sub
Sub WriteBinaryFile(ByVal fPath As String, value() As Byte)
Dim FN As Long
FN = FreeFile
Open fPath For Binary Lock Read Write As #FN
Put #FN, , value
Close #FN
End Sub
댓글목록0