尝试使用 VBA 从 Excel 工作表导出图像时出现运行时错误 438

Question

我正在尝试执行一个 VBA 脚本，该脚本将从 Excel 工作表中获取图像并将其以 .PNG 格式导出到预先确定的文件夹中。 我的代码如下：

Sub ExportGraphicsWithRowAndColumnInfo()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim imgNum As Integer
    Dim rowNum As Long
    Dim colNum As Long
    Dim imgPath As String
    
    ' Set folder path for exporting images
    imgPath = "C:\Users\Owner\Documents\Excel Exported Images\" ' Change this to your desired folder
    If Dir(imgPath, vbDirectory) = "" Then MkDir imgPath
    
    ' Loop through all sheets
    For Each ws In ThisWorkbook.Sheets
        imgNum = 1
        
        ' Loop through all shapes in the sheet
        For Each shp In ws.Shapes
            ' Check if the shape is not a chart (optional, adjust if needed)
            If Not shp.Type = msoChart Then
                ' Get the row and column of the top-left cell
                rowNum = shp.TopLeftCell.Row
                colNum = shp.TopLeftCell.Column
                
                ' Export the shape as an image (using Export method)
                shp.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                
                ' Save the picture to file
                Dim fileName As String
                fileName = imgPath & "Image_" & ws.Name & "_R" & rowNum & "_C" & colNum & ".png"
                
                ' Use Excel to save the copied image to the file system
                With CreateObject("Excel.Application")
                    .Visible = False ' Make Excel invisible
                    .Workbooks.Add
                    .ActiveSheet.Paste
                    .ActiveSheet.Shapes(1).Select
               **     .ActiveSheet.Shapes(1).Export fileName, 2 ' 2 is the value for PNG format**
                    .Quit
                End With
                
                ' Increment image counter
                imgNum = imgNum + 1
            End If
        Next shp
    Next ws
End Sub

我在“ActiveSheet.Shapes(1).Export fileName”行收到 438 运行时错误。

我之前尝试使用以下文本块代替当前的 CreateObject() 块来运行此代码：

With CreateObject("Word.Application")
    .Documents.Add.Content.Paste
    .ActiveDocument.SaveAs2 imgPath & "Image_" & ws.Name & "_R" & rowNum & "_C" & colNum & ".png"

这成功在指定文件夹中创建了 .png 文件，但图像为空白，并显示消息“看起来我们不支持此文件格式”。 目前，我不确定 438 错误的原因是什么以及如何解决。

Answer 1

作为我评论的后续内容，我使用 Jean Robert 在此链接中提供的一些代码调整了您的代码：使用 VBA 将图片从 excel 文件导出为 jpg。这是结果：

Sub ExportGraphicsWithRowAndColumnInfo()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim imgNum As Integer
    Dim rowNum As Long
    Dim colNum As Long
    Dim imgPath As String
    Dim oDia As Object
    Dim oChartArea As Object

    ' Set folder path for exporting images
    imgPath = "C:\Users\Owner\Documents\Excel Exported Images\" ' Change this to your desired folder
    If Dir(imgPath, vbDirectory) = "" Then MkDir imgPath

    ' Loop through all sheets
    For Each ws In ThisWorkbook.Sheets
        imgNum = 1

        ' Loop through all shapes in the sheet
        For Each shp In ws.Shapes
            ' Check if the shape is not a chart (optional, adjust if needed)
            If Not shp.Type = msoChart Then

                ' Get the row and column of the top-left cell
                rowNum = shp.TopLeftCell.Row
                colNum = shp.TopLeftCell.Column

                ' Put the picture in the clipboard
                shp.CopyPicture Appearance:=xlScreen, Format:=xlPicture

                ' Create a temporary chart object
                Set oDia = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)
                Set oChartArea = oDia.Chart
                oDia.Activate

                ' Paste the picture from the clipboard and export it
                With oChartArea
                    .ChartArea.Select
                    .Paste
                    .Export (imgPath & "Image_" & ws.Name & "_R" & rowNum & "_C" & colNum & ".png")
                End With
                oDia.Delete

                ' Increment image counter
                imgNum = imgNum + 1
            End If
        Next shp
    Next ws
End Sub