• 쇼핑몰
  • 커뮤니티
  • 북마크

vb6.0/vba




[vba] [vba] Excel에서 QR Code 사용하기

하나를하더라도최선을
2019.09.29 20:13 1,338 0
  • - 첨부파일 : QR Code.xlsm (20.9K) - 다운로드

본문



93212966061dab9c7783a922405bac10_1569755504_0455.png
 



Private Sub Worksheet_Change(ByVal C As Range)
    If C.Address(00<> "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

등록된 댓글이 없습니다.