最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

Run-time error 438 when trying to export images from Excel sheet using VBA - Stack Overflow

programmeradmin7浏览0评论

I am trying to execute a VBA script that will take images from an Excel sheet and export them to a pre-determined file folder in .PNG format. My code is as follows:

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

I am getting a 438 runtime error on the 'ActiveSheet.Shapes(1).Export fileName' line.

I previously tried to run this code with the following block of text in place of the current CreateObject() block:

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

This successfully created .png files in the specified folder, but the images were blank, and displayed the message "It looks like we don't support this file format". At this point, I am uncertain what the cause of the 438 error is and how to resolve it.

I am trying to execute a VBA script that will take images from an Excel sheet and export them to a pre-determined file folder in .PNG format. My code is as follows:

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

I am getting a 438 runtime error on the 'ActiveSheet.Shapes(1).Export fileName' line.

I previously tried to run this code with the following block of text in place of the current CreateObject() block:

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

This successfully created .png files in the specified folder, but the images were blank, and displayed the message "It looks like we don't support this file format". At this point, I am uncertain what the cause of the 438 error is and how to resolve it.

Share Improve this question edited Jan 17 at 19:58 BigBen 50.2k7 gold badges28 silver badges44 bronze badges asked Jan 17 at 19:55 f105thudf105thud 12 bronze badges 4
  • An Excel Shape doesn't have an Export method. – BigBen Commented Jan 17 at 19:59
  • Okay, then what can I do instead? – f105thud Commented Jan 17 at 20:05
  • You could use python rather than VBA – moken Commented Jan 17 at 23:04
  • 2 See the answer by Jean Robert here: https://stackoverflow/questions/18232987/export-pictures-from-excel-file-into-jpg-using-vba. I have tried the code and it works well. You will probably need to adapt it somewhat to meet your needs but the concept of using a chart object as a vehicle works. – BobS Commented Jan 17 at 23:08
Add a comment  | 

1 Answer 1

Reset to default 0

As a follow-on to my comment, I have adapted your code using some of the code supplied by Jean Robert at this link: Export pictures from excel file into jpg using VBA. In spite of the link title, it does export in PNG format. Here is the result:

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 FileName:=imgPath & "Image_" & ws.Name & "_R" & rowNum & "_C" & colNum & ".png", _
                            FilterName:="PNG"
                End With
                oDia.Delete

                ' Increment image counter
                imgNum = imgNum + 1
            End If
        Next shp
    Next ws
End Sub
发布评论

评论列表(0)

  1. 暂无评论