使用VBA导出Excel工作表图片时出现Run-time error 438错误

错误原因分析 #

• Run-time error 438：原代码中新建Excel实例并粘贴图片后，ActiveSheet.Shapes(1)指向的对象不支持Export方法。这是因为CopyPicture粘贴后，工作表生成的是Picture对象（而非Shape），或是粘贴操作未完成就访问Shapes集合，导致对象引用错误。
• Word方案生成空白文件：Word的SaveAs2无法直接将文档内容保存为有效PNG，它只是把Word文档重命名为.png，并非真正导出图片格式，因此会出现格式不支持的提示。

修正方案 #

方案1：直接使用Shape的Export方法（推荐） #

如果你的Shape是图片类对象（如msoPicture、msoLinkedPicture），可跳过复制粘贴步骤，直接调用Shape自身的Export方法，代码更简洁且避免实例创建的问题：

Sub ExportGraphicsWithRowAndColumnInfo()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim rowNum As Long
    Dim colNum As Long
    Dim imgPath As String
    
    ' 设置导出路径
    imgPath = "C:\Users\Owner\Documents\Excel Exported Images\"
    If Dir(imgPath, vbDirectory) = "" Then MkDir imgPath
    
    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Sheets
        ' 遍历工作表中的所有形状
        For Each shp In ws.Shapes
            ' 仅处理图片类形状（可根据需求调整）
            If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
                ' 获取形状左上角所在单元格的行和列
                rowNum = shp.TopLeftCell.Row
                colNum = shp.TopLeftCell.Column
                
                ' 直接导出为PNG
                shp.Export imgPath & "Image_" & ws.Name & "_R" & rowNum & "_C" & colNum & ".png", _
                           FilterName:="PNG"
            End If
        Next shp
    Next ws
End Sub

方案2：修正原代码的粘贴导出逻辑 #

如果必须使用复制粘贴的方式（比如需要导出屏幕显示效果的图片），可通过Chart对象中转导出，避免Shapes对象的兼容性问题：

Sub ExportGraphicsWithRowAndColumnInfo_Fixed()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim rowNum As Long
    Dim colNum As Long
    Dim imgPath As String
    Dim tempChart As ChartObject
    Dim fileName As String
    
    ' 设置导出路径
    imgPath = "C:\Users\Owner\Documents\Excel Exported Images\"
    If Dir(imgPath, vbDirectory) = "" Then MkDir imgPath
    
    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Sheets
        ' 遍历工作表中的所有形状
        For Each shp In ws.Shapes
            ' 排除图表（可根据需求调整）
            If Not shp.Type = msoChart Then
                ' 获取形状左上角所在单元格的行和列
                rowNum = shp.TopLeftCell.Row
                colNum = shp.TopLeftCell.Column
                fileName = imgPath & "Image_" & ws.Name & "_R" & rowNum & "_C" & colNum & ".png"
                
                ' 复制形状为图片
                shp.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                
                ' 创建临时图表，用于导出图片
                Set tempChart = ws.ChartObjects.Add(0, 0, shp.Width, shp.Height)
                tempChart.Activate
                tempChart.Chart.Paste
                
                ' 导出图表为PNG（图表中的图片会被一并导出）
                tempChart.Chart.Export fileName, "PNG"
                
                ' 删除临时图表
                tempChart.Delete
            End If
        Next shp
    Next ws
End Sub

关键说明 #

• 方案1的shp.Export仅适用于支持导出的Shape类型（如图片、剪贴画），如果是文本框、几何形状等其他类型Shape，建议使用方案2。
• 方案2通过临时Chart对象中转，能兼容所有可复制为图片的Shape类型，且无需新建Excel实例，性能更优。

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