如何确保Excel中IMAGE函数生成二维码后再执行打印？

我需要自动打印单元格中的二维码，目前采用的最优方案是使用Excel的IMAGE函数，对应公式为：
=IMAGE("https://api.qrserver.com/v1/create-qr-code/?data="&ENCODEURL(B2))

但修改单元格B2的值后执行打印操作时，时常出现二维码尚未生成就触发打印的情况，导致打印预览中二维码所在位置显示“Picture”文本。我尝试了多种VBA方法来确保IMAGE函数执行完成，但均不可靠，尝试的代码如下：

Sub ChangePrintedQR()
    Dim ImgRange As Range
    Set ImgRange = Range("B4")
    Range("B2") = Now
'    ImgRange.Formula = "=IMAGE(""https://api.qrserver.com/v1/create-qr-code/?data=""&ENCODEURL(B2))" 'Having this line can print "Busy" instead of "Picture"

'    While ImgRange.Text = "Picture"    'This gets stuck in an infinite loop
'        Debug.Print ImgRange.Text      'regardless of this line, trying the Value of the cell does the same
'    Wend

'    Application.Calculate              'This method does nothing
'    If Not Application.CalculationState = xlDone Then
'        DoEvents
'    End If

'    Application.Wait (Now + TimeValue("0:00:10"))   'This results in the waiting, but no change to the printed sheet.

    ActiveSheet.PrintPreview
End Sub

可行解决方案 #

方案1：验证图片加载状态后再打印

IMAGE函数生成的图片会以Shape对象的形式存在于工作表中，我们可以通过检查Shape的Picture属性来确认二维码是否加载完成：

Sub PrintUpdatedQRCode()
    Dim qrCell As Range
    Dim qrShape As Shape
    Dim waitTimeout As Integer
    
    ' 定位二维码所在单元格
    Set qrCell = Range("B4")
    ' 更新二维码数据源
    Range("B2") = Now
    
    ' 强制全量重新计算，确保IMAGE公式触发更新
    Application.CalculateFullRebuild
    
    ' 查找对应单元格的二维码Shape
    For Each qrShape In ActiveSheet.Shapes
        If qrShape.TopLeftCell.Address = qrCell.Address Then
            ' 循环等待图片加载，设置10秒超时防止无限等待
            waitTimeout = 0
            Do While qrShape.Picture Is Nothing And waitTimeout < 10
                DoEvents ' 释放系统资源，允许Excel加载图片
                Application.Wait Now + TimeValue("00:00:01")
                waitTimeout = waitTimeout + 1
            Loop
            Exit For
        End If
    Next qrShape
    
    ' 执行打印预览
    ActiveSheet.PrintPreview
End Sub

方案2：VBA直接生成二维码（无外部API依赖）

如果外部API的加载延迟始终无法稳定解决，可以改用VBA直接生成二维码并插入单元格，彻底避免加载等待问题：

' 需先在Excel中启用「Microsoft QR Code Control 6.0」控件
Sub GenerateAndPrintQRCode()
    Dim qrCode As Object
    Dim qrCell As Range
    Dim existingShape As Shape
    
    Set qrCell = Range("B4")
    
    ' 清除单元格内原有二维码
    For Each existingShape In ActiveSheet.Shapes
        If existingShape.TopLeftCell.Address = qrCell.Address Then
            existingShape.Delete
        End If
    Next
    
    ' 创建二维码对象并设置数据
    Set qrCode = CreateObject("Microsoft.QRCode")
    qrCode.Data = Range("B2").Value
    
    ' 将生成的二维码插入目标单元格
    ActiveSheet.Shapes.AddPicture _
        qrCode.Picture, _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=qrCell.Left, Top:=qrCell.Top, Width:=qrCell.Width, Height:=qrCell.Height
    
    ' 执行打印预览
    ActiveSheet.PrintPreview
End Sub

内容的提问来源于stack exchange，提问作者Marshall Gaunt