vba [vba] Excel에서 QR Code 사용하기
페이지 정보
본문
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
첨부파일
-
QR Code.xlsm (20.9K)
10회 다운로드 | DATE : 2019-09-29 20:13:09
- 이전글[vba] InputBox 에 PasswordChar 적용하기 / InputBox 로 비밀번오 입력받기 19.09.29
- 다음글[vba] Window API 를 이용한 Clipboard 의 Bitmap 저장하기 19.09.29
댓글목록
등록된 댓글이 없습니다.