This code snippet will allow you to save all your existing charts into a GIF format. It will save them in a folder called /Charts located in the ThisWorkbook.Path directory.
This can be useful if you need to code an Index for your charts, or you want to output a Chart Report sheet in HTML or whatever. I found it extremely useful after I had finished implementing it, and I hope others will to.
In order for the following code to work, you will need to add a reference to "Microsoft Scripting Runtime" in your Tools > References (VBA editor). So without further delay, here is the code:
Code
'Sub to save all existing charts to file
Sub SaveAllCharts()
For Each ws In Worksheets
ws.Activate
If ActiveSheet.ChartObjects.Count <> 0 Then
For I = 1 To ActiveSheet.ChartObjects.Count
Call SaveChartAsGIF(ws.Name, I)
Next I
End If
Next ws
End Sub
'***Function will save the chart in gif format
Function SaveChartAsGIF(SheetName, ChartID)
'Temp dimensions to save current chart size and position
Dim H As Double
Dim W As Double
Dim T As Double
Dim L As Double
'FileName variable, and FSO
Dim FName As String
Dim RepString As String
Dim mFileSysObj As New FileSystemObject
'select chart
Worksheets(SheetName).Activate
ActiveSheet.ChartObjects(ChartID).Activate
ActiveChart.ChartArea.Select
'Set chart object in a variable
Dim ChtOb As ChartObject
Set ChtOb = ActiveChart.Parent
'Save current dimensions and position
H = ChtOb.Height
W = ChtOb.Width
T = ChtOb.Top
L = ChtOb.Left
'Set printable size
ChtOb.Height = 288
ChtOb.Width = 500
ChtOb.Top = 144
ChtOb.Left = 182.25
'create Charts directory
FName = ThisWorkbook.Path & "\Charts\" & ActiveChart.Name & ".gif"
For I = 1 To 99
RepString = " Chart " & CStr(I)
FName = Replace(FName, RepString, "")
Next I
If mFileSysObj.FolderExists(ThisWorkbook.Path & "\Charts\") = False Then
Call mFileSysObj.CreateFolder(ThisWorkbook.Path & "\Charts\")
End If
'Save the Chart to a GIF format
ActiveChart.Export Filename:=FName, FilterName:="GIF"
'Restore original dimensions
ChtOb.Height = H
ChtOb.Width = W
ChtOb.Top = T
ChtOb.Left = L
End Function
Display More
If anyone is interested, I can also post my code that displays all these GIF charts into a web browser. Enjoy.