如何通过VBA将API生成的二维码作为Shape插入Word文档？

你的问题核心有两个：一是Word的Shapes.AddPicture仅支持本地文件路径/UNC路径，不直接兼容URL；二是二维码API返回的是二进制PNG数据，不能用responseText（文本处理属性）接收。

以下是完整的实现步骤及代码：

核心思路 #

1. 通过HTTP请求获取二维码的二进制数据
2. 将二进制数据保存为本地临时PNG文件，让AddPicture可以正常识别
3. 插入图片到指定Word表格单元格，完成后可清理临时文件

完整VBA代码示例 #

Sub InsertQRCodeIntoTable()
    Dim http As Object
    Dim sURL As String
    Dim QR_Value As String
    Dim tempFilePath As String
    Dim fileNum As Integer
    Dim targetCell As Cell
    Dim qrShape As Shape
    
    ' 替换为你的二维码内容
    QR_Value = "需要生成二维码的内容"
    
    ' 构建API请求URL（保留你的编码逻辑）
    sURL = "https://api.qrserver.com/v1/create-qr-code/?data=" & UTF8_URL_Encode(VBA.Replace(QR_Value, " ", "+")) & "&size=240x240"
    
    ' 初始化HTTP对象（后期绑定，无需额外引用库）
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", sURL, False
    http.Send
    
    ' 检查请求是否成功
    If http.Status <> 200 Then
        MsgBox "二维码请求失败，状态码：" & http.Status
        Exit Sub
    End If
    
    ' 生成唯一临时文件路径
    tempFilePath = Environ("TEMP") & "\temp_qr_" & Format(Now(), "YYYYMMDDHHMMSS") & ".png"
    
    ' 将二进制数据写入临时文件
    fileNum = FreeFile()
    Open tempFilePath For Binary Access Write As #fileNum
        Put #fileNum, , http.responseBody
    Close #fileNum
    
    ' 定位到目标表格单元格（示例为第1个表格的第1行第1列，按需修改）
    Set targetCell = ActiveDocument.Tables(1).Cell(1, 1)
    
    ' 插入图片到单元格
    Set qrShape = ActiveDocument.Shapes.AddPicture( _
        Filename:=tempFilePath, _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=targetCell.Range.Left, _
        Top:=targetCell.Range.Top, _
        Width:=targetCell.Width, _
        Height:=targetCell.Height)
    
    ' 锚定图片到单元格，防止编辑时错位
    qrShape.Anchor = targetCell.Range
    
    ' 可选：删除临时文件，清理垃圾
    Kill tempFilePath
    
    ' 释放对象
    Set http = Nothing
    Set targetCell = Nothing
    Set qrShape = Nothing
End Sub

' 保留你原有的UTF8 URL编码函数
Function UTF8_URL_Encode(strText As String) As String
    Dim objUTF8 As Object
    Set objUTF8 = CreateObject("System.Text.UTF8Encoding")
    Dim arrBytes() As Byte
    arrBytes = objUTF8.GetBytes_4(strText)
    Dim i As Integer
    Dim strEncoded As String
    For i = LBound(arrBytes) To UBound(arrBytes)
        strEncoded = strEncoded & "%" & Hex(arrBytes(i))
    Next i
    UTF8_URL_Encode = strEncoded
    Set objUTF8 = Nothing
End Function

关键细节说明 #

• responseBody的使用：API返回的是PNG二进制流，必须用responseBody接收，用responseText会导致二进制数据被错误转码损坏。
• 临时文件处理：用系统临时目录+时间戳生成唯一文件名，避免重复冲突；插入完成后删除临时文件，保持环境整洁。
• 图片锚定：设置Anchor为单元格的Range，确保图片不会随文档编辑错位。
• 参数调整：可根据需求修改表格索引、单元格位置、二维码尺寸等参数。

内容的提问来源于stack exchange，提问作者Ultra Junkie