excel怎么批量生成二维码_excel批量将文本内容转为二维码方法

Sub 批量生成二维码()
    Dim rng As Range, cell As Range
    Dim url As String, encodedText As String
    Dim http As Object, wbPath As String
    Set rng = Selection
    wbPath = ThisWorkbook.Path & "\二维码输出\"
    MkDir wbPath ' 创建输出目录
    For Each cell In rng
        If cell.Value <> "" Then
            encodedText = WorksheetFunction.EncodeURL(cell.Value) ' 需自行实现编码函数或使用替代方案
            url = "https://api.qrserver.com/v1/create-qr-code/?size=200x200&data=" & encodedText
            Set http = CreateObject("MSXML2.XMLHTTP")
            http.Open "GET", url, False
            http.Send
            If http.Status = 200 Then
                Dim stream As Object
                Set stream = CreateObject("ADODB.Stream")
                stream.Open
                stream.Type = 1
                stream.Write http.responseBody
                stream.SaveToFile wbPath & "QR_" & cell.Row & ".png", 2
                stream.Close
                ActiveSheet.Pictures.Insert wbPath & "QR_" & cell.Row & ".png"
                With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
                    .Top = cell.Offset(0, 1).Top
                    .Left = cell.Offset(0, 1).Left
                    .Width = 100
                    .Height = 100
                End With
            End If
        End If
    Next cell
End Sub