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.

• excel
• vba

• 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

1 Answer 1

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