Saturday, November 10, 2007

Exporting Excel Charts, Shapes, Ranges, and Selections to a GIF via a VB macro

By and large, Excel does a crappy job of exporting different objects into other applications or into separate files. I experienced this firsthand trying to export files to GIFs in order to post screenshots for this blog. After some web sluething and copying, I hacked up a VB macro to export a .gif image of whatever you have selected, in the resolution you're looking at it.


Sub ExportGif()
'
' Macro recorded 11/6/2007 by ConsultantNinja ConsultantNinja.com
' Based on http://www.dailydoseofexcel.com/archives/2006/09/29/excel-to-gif/
' Keyboard Shortcut: Ctrl+Shift+E
'
sSaveName = ActiveWorkbook.Path & "\Chart.gif"
Dim Hi As Integer
Dim Wi As Integer
Dim wbChart As Workbook
Dim Hincrease As Single
Dim Vincrease As Single
Dim Cht As ChartObject, Sh As Worksheet, Shp As Shape
Dim sChtName As String

Selection.Copy
Set Var1 = Selection

Hi = Selection.Height + 10 'adjustment for gridlines
Wi = Selection.Width + 10 'adjustment for gridlines

Set wbChart = Workbooks.Add
wbChart.Sheets(1).Name = "GIFcontainer"
Parent.Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="GIFcontainer"

Set Sh = wbChart.Sheets(1)
Set Cht = Sh.ChartObjects(1)
Set Shp = Sh.Shapes(Cht.Name)

Hincrease = Hi / Cht.Height
Shp.ScaleHeight Hincrease, _
msoFalse, msoScaleFromTopLeft

Vincrease = Wi / Cht.Width
Shp.ScaleWidth Vincrease, _
msoFalse, msoScaleFromTopLeft

Var1.Copy

If TypeName(Var1) = "ChartArea" Then
wbChart.Sheets(1).ChartObjects(1).Chart.Paste
ElseIf TypeName(Var1) = "Range" Then
wbChart.Sheets(1).Pictures.Paste(Link:=True).Select
wbChart.Sheets(1).Pictures(1).Copy
wbChart.Sheets(1).ChartObjects(1).Chart.Pictures.Paste
ElseIf TypeName(Var1) = "GroupObject" Then
wbChart.Sheets(1).Pictures.Paste.Select
wbChart.Sheets(1).Pictures.Paste.Copy
wbChart.Sheets(1).ChartObjects(1).Chart.Paste
End If

ActiveChart.ChartArea.Select
Selection.Border.LineStyle = 0
wbChart.Sheets(1).ChartObjects(1).Chart.Export Filename:=sSaveName, FilterName:="GIF"

Avbryt:
Application.StatusBar = False
wbChart.Close False

End Sub

3 comments:

Jon Peltier said...

You need a case for a single shape. Also, if someone has selected a different chart element than the chart area, nothing will be copied.

Why not export a selected chart directly, rather than copying it into the GIFcontainer chart?

Check for 'Not ActiveChart Is Nothing', and if that's true, export the active chart directly, otherwise go to the Case statement.

Jon Peltier said...

While you based your code on an example in Daily Dose, you should note that the code initially was developed by Harald Staff, and is posted on http://www.mvps.org/dmcritchie/excel/xl2gif.htm

DenisStarbank said...

Its years since you wrote this, but its still reaaly useful.
Thanks!
denis@blueyonder.co.uk

Saturday, November 10, 2007