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 |1 Answer
Reset to default 0As 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
Shape
doesn't have anExport
method. – BigBen Commented Jan 17 at 19:59