A quick post with a little function I created based off of a recent forum answer I provided to help an Excel user.
Predefined Export Image Format
Below is a very simply sub routine that will save the designated range to a jpg image file.
The basic concept is that we copy the range, create a chart object, paste the range content to the chart and export the chart object to a jpg file (since it offers such functionality!). Enough talk, here the sub.
'---------------------------------------------------------------------------------------
' Procedure : ExportRangeAsImage
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Capture a picture of a worksheet range and save it to disk
' Returns True if the operation is successful
' Note : *** Overwrites files, if already exists, without any warning! ***
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' ws : Worksheet to capture the image of the range from
' rng : Range to capture an image of
' sFile : Fully qualified path and filename to save the image to (with the .jpg extension)
'
' Usage:
' ~~~~~~
' ? ExportRangeAsImage(Sheets("Sheet1"), Range("A1"), "C:\Temp\Charts\test01.jpg")
' ? ExportRangeAsImage(Sheets("Products"), Range("D5:F23"), "C:\Temp\Charts\test02.jpg")
' ? ExportRangeAsImage(Sheets("Sheet1"), Range("A1"), "C:\Temp\Charts\test01.png")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2020-04-06 Initial Release
'---------------------------------------------------------------------------------------
Function ExportRangeAsImage(ws As Worksheet, _
rng As Range, _
sFile As String) As Boolean
Dim oChart As ChartObject
On Error GoTo Error_Handler
Application.ScreenUpdating = False
ws.Activate
rng.CopyPicture xlScreen, xlPicture 'Copy Range Content
Set oChart = ws.ChartObjects.Add(0, 0, rng.Width, rng.Height) 'Add chart
oChart.Activate
With oChart.Chart
.Paste 'Paste our Range
.Export sFile, "JPG" 'Export the chart as an image
End With
oChart.Delete 'Delete the chart
ExportRangeAsImage = True
Error_Handler_Exit:
On Error Resume Next
Application.ScreenUpdating = True
If Not oChart Is Nothing Then Set oChart = Nothing
Exit Function
Error_Handler:
'76 - Path not found
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExportRangeAsImage" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
This function could further be expanded to test for the save Path and create it if it doesn’t already exist, check if the file already exists and ask if it should be overwritten, …
Exported Image Format
Also note, that the exported image format can be changed by simply updating the “JPG” value and the supplied sFile argument value. As such, you can specify JPG, PNG, GIF, BMP (I tested these and they all work), beyond that you will have to test and see for yourself as the documentation on the Chart.Export method offers no information on the subject! That said, in my tests, the TIFF image format failed (the file would be created, but was unreadable/garbage).
Dynamic Export Image Format – Flexible Version
So knowing that the export routine is flexible enough that it can export the image in a variety of image formats, we could alter the above procedure to make it accept a format as an input argument and provide us with the greatest flexibility possible at runtime, rather than editing the code each and every time or needing multiple versions of the same function. So, below is an example of what can be done.
' Procedure : ExportRangeAsImage
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Capture a picture of a worksheet range and save it to disk
' Returns True if the operation is successful
' Note : *** Overwrites files, if already exists, without any warning! ***
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' ws : Worksheet to capture the image of the range from
' rng : Range to capture an image of
' sPath : Fully qualified path where to export the image to
' sFileName : filename to save the image to WITHOUT the extension, just the name
' sImgExtension : The image file extension, commonly: JPG, GIF, PNG, BMP
' If omitted will be JPG format
'
' Usage:
' ~~~~~~
' ? ExportRangeAsImage(Sheets("Sheet1"), Range("A1"), "C:\Temp\Charts\", "test01". "JPG")
' ? ExportRangeAsImage(Sheets("Products"), Range("D5:F23"), "C:\Temp\Charts", "test02")
' ? ExportRangeAsImage(Sheets("Sheet1"), Range("A1"), "C:\Temp\Charts\", "test01", "PNG")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2020-04-06 Initial Release
'---------------------------------------------------------------------------------------
Function ExportRangeAsImage(ws As Worksheet, _
rng As Range, _
sPath As String, _
sFileName As String, _
Optional sImgExtension As String = "JPG") As Boolean
Dim oChart As ChartObject
On Error GoTo Error_Handler
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
Application.ScreenUpdating = False
ws.Activate
rng.CopyPicture xlScreen, xlPicture 'Copy Range Content
Set oChart = ws.ChartObjects.Add(0, 0, rng.Width, rng.Height) 'Add chart
oChart.Activate
With oChart.Chart
.Paste 'Paste our Range
.Export sPath & sFileName & "." & LCase(sImgExtension), sImgExtension 'Export the chart as an image
End With
oChart.Delete 'Delete the chart
ExportRangeAsImage = True
Error_Handler_Exit:
On Error Resume Next
Application.ScreenUpdating = True
If Not oChart Is Nothing Then Set oChart = Nothing
Exit Function
Error_Handler:
'76 - Path not found
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExportRangeAsImage" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
thank you
My Excel VBA solution
1. range.Select
2. range.CopyPicture
3. Paste it
4. Cut it for storing to system clipboard ( key-point )
5. create windows powershell command in one-line
6. execute powershell by Shell
“`VBA
Sub 巨集1()
PicDir = ActiveWorkbook.Path & “\”
PicFile = Format(Now(), “hh-mm”) & “.png”
Sheets(“工作表1”).Select
Range(“Q1:U10”).CopyPicture Appearance:=xlScreen, Format:=xlPicture ‘複製範圍成圖檔
ActiveSheet.Paste ‘要利用這動作-1,才會真的存到 Clipboard
ActiveSheet.Shapes.Range(Array(Selection.ShapeRange.Name)).Select ‘選剛貼上的 Shape
Selection.Cut ‘要利用這動作-2,才會真的存到 Clipboard
sPSCmd = “powershell $img = get-clipboard -format image ; $img.Save(‘” & PicDir & PicFile & “‘)” ‘把 Clipboard 內容存成圖檔的 PowerShell
RetVal = Shell(sPSCmd, 0) ‘無聲無息的執行
End Sub
Hello,
how do I call the function correctly?
Function ExportRangeAsImage(ws As Worksheet, _
rng As Range, _
sFile As String) As Boolean
I get an error message at the end of the line “ExportRangeAsImage(Sheets(“Products”), Range(“D5:F23”), “C:\Temp\Charts\test02.jpg”)”
Error compiling
Expected: =
Normally, you’d do something like
If ExportRangeAsImage(Sheets("Products"), Range("D5:F23"), "C:\Temp\Charts\test02.jpg") Then 'It worked, now what Else 'Something went wrong, notify the user??? End If