자료실

부자는 돈을 써서 시간을 아끼지만 가난한 사람은 시간을 써서 돈을 아낀다

vb6.0/vba

IT HUB를 찾아주셔서 감사합니다.

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

페이지 정보

profile_image
작성자 하나를하더라도최선을
댓글 0건 조회 10,047회 작성일 19-09-29 20:13

본문

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


첨부파일

댓글목록

등록된 댓글이 없습니다.