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

Asatoma Sadgamaya
Asatoma Sadgamaya used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2008

Commented:
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?
Top Expert 2008

Commented:
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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial