asked on

Access vba to copy range of excel cells and save as jpeg

Hi please find below vba script, which helps me to copy range of excel cells and save it as a jpeg file. I want this code to run from ms access vba editor.

Basically

1. Open an excel workbook
2. Go to a given tab
3. Copy range of cells.
4. Save as a jpec file in a given folder

Please have a look

Sub ExportRange()

   Const FName          As String = "C:\TEMP\export.jpg"

   Dim rng              As Range

   Dim shtTemp          As Worksheet

   Dim chtTemp          As Chart

 

   Application.ScreenUpdating = False

   '// Change range as needed

   Set rng = Worksheets("Sheet1").Range("A1:C10")

 

   '// Add a temp worksheet. Chart will be placed on this. It will be deleted after

   Set shtTemp = Worksheets.Add

   '// Add chart

   Charts.Add

   '// Move the chart to the new sheet and get a reference to it

   ActiveChart.Location Where:=xlLocationAsObject, Name:=shtTemp.Name

   Set chtTemp = ActiveChart

 

   '// Copy and paste the range

   rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

   chtTemp.Paste

 

   '// Export

   chtTemp.Export Filename:=FName

 

   '// Tidy up...

   Application.DisplayAlerts = False

   shtTemp.Delete

   Application.DisplayAlerts = True

   Application.ScreenUpdating = True

 

End Sub

Open in new window

Thank you
A

irudyk

This code seem to be running from within an Excel file. In Access will you be opening the Excel file and if so what would it's path be?

irudyk

Assuming that you are opening the Excel file the following would work. Just change the Const XLFName to the Excel file you want

Sub ExportRange()

   Const FName          As String = "C:\TEMP\export.jpg"
   Const XLFName        As String = ""C:\TEMP\Book1.xlsx"

   Dim xl               As Object
   Dim rng              As Object
   Dim shtTemp          As Object
   Dim chtTemp          As Object
   
   Set xl = CreateObject("Excel.Application")
   xl.Workbooks.Open XLFName

   '// Change range as needed

   Set rng = xl.Worksheets("Sheet1").Range("A1:C10")

    '// Add a temp worksheet. Chart will be placed on this. It will be deleted after

   Set shtTemp = xl.Worksheets.Add

   '// Add chart

   xl.Charts.Add

   '// Move the chart to the new sheet and get a reference to it

   xl.ActiveChart.Location Where:=xlLocationAsObject, Name:=shtTemp.Name

   Set chtTemp = xl.ActiveChart

   '// Copy and paste the range

   rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

   chtTemp.Paste

   '// Export

   chtTemp.Export FileName:=FName

   '// Tidy up...

   xl.Application.DisplayAlerts = False

   shtTemp.Delete

   xl.ActiveWorkbook.Close 0
   
   xl.Quit

End Sub

Open in new window

This question needs an answer!

Become an EE member today

7 DAY FREE TRIAL

Members can start a 7-Day Free trial then enjoy unlimited access to the platform.

View membership options

Learn why we charge membership fees

We get it - no one likes a content blocker. Take one extra minute and find out why we block content.