Excel VBA循环中将形状填充为图片时图片未更新问题求助

问题原因 #

你的代码存在4个核心问题导致图片无法更新：

• 语法错误：两个With代码块都没有写对应的End With，语法逻辑异常导致后续填充图片的代码没有正确执行
• 公式未触发重算：修改Selected_Property单元格值后，依赖它的Image_Path、Map_Path是INDEX MATCH公式，没有主动触发工作簿重算，拿到的还是上一次的路径值
• 关闭了屏幕刷新：你设置了Application.ScreenUpdating = False，图片填充属于界面渲染操作，在屏幕刷新关闭的状态下不会实际生效，导出PDF时读取的仍是旧的图片缓存
• 不规范的Select用法：依赖Selection对象操作形状容易出现引用错误，还会带来不必要的性能开销

修正方案 #

按照下面的逻辑修改代码即可解决问题：

1. 补全所有End With闭合代码块
2. 修改Selected_Property后主动触发公式重算
3. 填充图片后加DoEvents让系统完成待处理的界面操作，保证图片渲染完成
4. 去掉不必要的Select操作，直接引用形状对象避免引用错误

Public Sub Print_all_to_pdf()
    Dim i As Integer
    Dim cur_val As Integer
    Dim props_cnt As Integer
    Dim image_path As Variant
    Dim map_path As Variant
    Dim ws As Worksheet
    
    ' 提前绑定当前工作表，避免引用错误
    Set ws = ActiveSheet
    Application.ScreenUpdating = False
    
    cur_val = ws.Range("Selected_Property").Value
    props_cnt = ws.Range("Max_Property").Value
    
    For i = cur_val To props_cnt
        ws.Range("Selected_Property").Value = i
        ' 触发公式重算，更新图片路径
        Application.Calculate
        
        image_path = ws.Range("Image_Path").Value
        map_path = ws.Range("Map_Path").Value
        
        ' 直接操作形状，无需Select
        With ws.Shapes("Image").Fill
            .Visible = msoTrue
            .UserPicture image_path
            .TextureTile = msoFalse
            .RotateWithObject = msoTrue
        End With ' 补全With闭合
        
        With ws.Shapes("Map").Fill
            .Visible = msoTrue
            .UserPicture map_path
            .TextureTile = msoFalse
            .RotateWithObject = msoTrue
        End With ' 补全With闭合
        
        ' 等待界面操作完成，保证图片加载完毕
        DoEvents
        
        Call export_report_as_pdf
    Next i
    
    ws.Range("Selected_Property").Value = cur_val
    Application.ScreenUpdating = True
End Sub

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