Sometimes we have to do silly stuff…
No surprise my next sentence starts with: -At work…
At work I ran in to the task of having to deliver -repeatedly- a small table from one of our reports as a .jpg to be inserted in to a powerpoint presentation.
I tried to explain that you can actually insert excel tables and files into presentation but the person made the powerpoint monster was adament. So it was .jpg or nothing.
I searched high and low on how can I achieve this. Then I found a solution.
By all means there are hundreds of ways to do this and this is one way.
Take it as a starting point, improve on it, tailor it to your project and if you kind enough share your solution with us. The main point is that you have something to start on.
What this code does:
It grabs a range as jpg. That is a given. However this jpg is in the memory, in the clipboard. you can’t export it.
So to be able to export it we have to add it to an object.
For this we create a temporary sheet.
Adding in a chart on the sheet.
Resize it a little.
Then export the .jpg
In the code below there is two thing you need to specify:
The range you want to grab.
The path you want to export your file out to. (Make sure that the folder exist! Otherwise you will have an error)
Option Explicit Sub ExportNumChart() 'The path you need to modify: Const FName As String = "D:My DocumentsMy PicsNumbers.jpg" Dim pic_rng As Range Dim ShTemp As Worksheet Dim ChTemp As Chart Dim PicTemp As Picture 'Speed Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'Set the range you want to put in the pic Set pic_rng = Worksheets("Numbers").Range("B1:F25") 'Adding temporary worksheet Set ShTemp = Worksheets.Add 'Making a chart Charts.Add ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name Set ChTemp = ActiveChart 'Adding the picture of the range to the chart pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture ChTemp.Paste Set PicTemp = Selection 'Manually adjusting the size of the chart to suit your range size With ChTemp.Parent .Width = PicTemp.Width + 8 .Height = PicTemp.Height + 8 End With 'Exporting it ChTemp.Export Filename:="D:My DocumentsMy PicsNumbers.jpg", FilterName:="jpg" 'Delete the temp sheet Application.DisplayAlerts = False ShTemp.Delete Application.DisplayAlerts = True 'Give speed back Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
What you could improve on the code:
The sizing of the range is a bit of a trial and error thing. But since this was a hit and run code, meaning that I have to set it up once then run it daily or better pass it on to some poor soul to run it daily I wasnt too concerned.
But if you open the pictire you will see that there is a slight border around it.
You might not be too bothered about it. I really wanted to find a solution to remove it but the lack of time on this project did not made it possible.
I hope that you can make use of this code. I thought it would be interesting to share it.
If you liked this post come and have a dig around in our Excel VBA Category Hopefully you can grab a few useful snippets.
Come and visit us.
Come and visit excelangel on Facebook to find and join the growing community of true office workers.
Oh, I almost forgot.
Drop us a like while you there…