VBA to save a chart as a GIF

[Barb Reinhardt]

I have the following snippet of code to save a chart as a GIF. What am I
missing?

For Each WS In aWB.Worksheets
For Each ChtObj In WS.ChartObjects

If ChtObj.Name = "myName.gif" Then
fname = aWB.Path & "\myFileName.gif"
WS.Select
ChtObj.Select
ChtObj.Export Filename:=fname, FilterName:="GIF"
End If
Next ChtObj
Next WS


Thanks,
Barb Reinhardt

 

[Jon Peltier]

If the chartobject's name is in fact "myName.gif", this should work. No need
to select worksheet or chart object, but you need to export the chart, not
the parent chartobject.

For Each WS In aWB.Worksheets
For Each ChtObj In WS.ChartObjects

If ChtObj.Name = "myName.gif" Then
fname = aWB.Path & "\myFileName.gif"
ChtObj.Chart.Export Filename:=fname, FilterName:="GIF"
End If
Next ChtObj
Next WS

- Jon

 

[Don Guillett]

See if this helps
For Each c In ActiveSheet.Shapes
'MsgBox c.Name
if c.Name = "Picture 1" Then MsgBox "OK"
Next

Sub ExportChartGIF()
ActiveChart.Export Filename:="C:\a\MyChart.gif", _
FilterName:="GIF"
End Sub

 

[Barb Reinhardt]

Thanks for helping to identify my two problems. In error, I had checked for
the chart name with a .gif at the end. I also needed to change

ChtObj.Export Filename:=fname, FilterName:="GIF"

to

ChtObj.Chart.Export Filename:=fname, FilterName:="GIF"

Thanks again Jon,

Barb

 

[Barb Reinhardt]

Hey Jon, I have another related question. How would I save workbook level
named range "YTD_Summary" as a GIF image?

Thanks again,
Barb

 

[Jon Peltier]

To export a range, you need to copy it into a blank chart, and export the
blank chart. Harald Staff wrote and David McRitchie posted an XL2GIF routine
that does this:

http://www.mvps.org/dmcritchie/excel/xl2gif.htm

- Jon

 

[Peter T]

Here's another 'bare bones' one ( I wasn't aware of the link to Harold
Staff's as posted by Jon)

Sub RangeToGif(rng As Range, sFile As String)
Dim sName As String

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

With ActiveSheet.ChartObjects.Add(0, 0, 100, 100)
.Width = rng.Width + 4
.Height = rng.Height + 4
'.Chart.ChartArea.Border.LineStyle = xlNone
.Chart.Pictures.Paste
' to do: check if sFile already exists etc
.Chart.Export sFile ' best to omit FilterName for default Gif

End With
' comment this for testing
ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete

End Sub

Sub test()
Dim rng As Range
Set rng = Range("myName") 'Selection.Cells
' to do: check the range is a sensible size
RangeToGif rng, "C:\RangeToGif.Gif"
End Sub

You may prefer to copy to a temporary chart sheet which is sized to default
paper size, see arguments for CopyPicture in Help.

Regards,
Peter T