Tạo mã QRCode từ VBA Excel

    Sub TaoQRCode()

    Dim noidungtao As String

    Dim QRCodeURL As String

    Dim ws As Worksheet

    Dim img As Picture

    Dim FilePath As String



    ' Lấy dữ liệu từ ô A1

    noidungtao = ThisWorkbook.Sheets("Sheet1").Range("A1").Value

    QRCodeURL = "https://quickchart.io/qr?text=" & noidungtao & "&size=150"

    

    ' Tạo đường dẫn file tạm để lưu ảnh

    FilePath = Environ$("temp") & "\qrcode.png"

    

    ' Tải ảnh từ URL và lưu vào file tạm

    DownloadFile QRCodeURL, FilePath

    

    ' Xóa mã QR cũ nếu có

    On Error Resume Next

    ThisWorkbook.Sheets("Sheet1").Pictures("QRCode").Delete

    On Error GoTo 0



    ' Thêm hình ảnh mã QR vào sheet

    Set ws = ThisWorkbook.Sheets("Sheet1")

    Set img = ws.Pictures.Insert(FilePath)

    

    ' Đặt tên và vị trí ảnh

    With img

        .Name = "QRCode"

        .Top = ws.Range("B1").Top

        .Left = ws.Range("B1").Left

        .Width = 150

        .Height = 150

    End With

End Sub

Sub DownloadFile(ByVal URL As String, ByVal SavePath As String)

    Dim WinHttp As Object

    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

    

    WinHttp.Open "GET", URL, False

    WinHttp.Send

    

    If WinHttp.Status = 200 Then

        Dim adoStream As Object

        Set adoStream = CreateObject("ADODB.Stream")

        adoStream.Type = 1 ' Binary

        adoStream.Open

        adoStream.Write WinHttp.ResponseBody

        adoStream.SaveToFile SavePath, 2 ' Overwrite if exists

        adoStream.Close

    Else

        MsgBox "Không thể tải mã QR. HTTP Status: " & WinHttp.Status

    End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("A1")) Is Nothing Then

        Call TaoQRCode

    End If

End Sub