'Author: Krishna Kant
'Save all charts on the current worksheet in PNG and EPS format.
'The names are derived by concatenating first 4 (or all for shorter
'titles) words of each chart title, optionally followed by a seq
'no to ensure unique file names.
'NOTEs:
'   1. Since this routine does not overwrite files, please delete
'       existing files before re-running, else seq nos. will be
'       appended to generated files to avoid overwriting existing ones.
'   2. seq no is a global variable, not specific to each file-name.
'   3. This routine will bomb if some chart doesn't have a title.
'   4. This routine is completely independent of spreadsheet specifics,
'       and can be safely used with any spreadsheet.
'   5. See below and set the variable "generate_eps" to generate
'       .png/.eps or .png/.bb files. The latter allows inclusion of
'       .png in latex via \DeclareGraphicsRule{} command.
'   6.  Excel seems to arbitrarily increase font sizes and hence sizes of
'       legend boxes and such during conversion to PNG. Keep font sizes
'       small to be prepared for this. For the usual IEEE format, using
'       Arial, size 8 or smaller for everything seems to work well.
'   7.  The replaces below are really embarassing; I really wanted to do the
'       regular expression replace listed below, but VB is clueless. Another
'       stupidity: more than one space in a row are treated as words by
'       split! Hence the 2 tries on replacing "  " by " ". How ugly!!
'
Const max_limit As Integer = 3   '1 less than #words used for file name
Const generate_eps As Boolean = True

Sub ChartPict_save()
Dim sFName, inpname, outname, fname, arg As String
Dim tokens As Variant
Dim Pict As Object
Dim ch, fs
Dim i, j, limit, count As Integer
count = 0
i = 1
Set fs = CreateObject("Scripting.FileSystemObject")
For Each Pict In ActiveSheet.ChartObjects
    Set ch = Pict.Chart
    'sFName = ThisWorkbook.Path & Application.PathSeparator & Pict.Chart.ChartTitle.Text
    sFName = Pict.Chart.ChartTitle.Text
    'sFName = Replace(sFName, "[!A-Za-z0-9_.]", "")   'DOESN'T WORK!!!!
    sFName = Replace(sFName, "!", "")
    sFName = Replace(sFName, "%", "")
    sFName = Replace(sFName, "^", "")
    sFName = Replace(sFName, "&", "")
    sFName = Replace(sFName, "*", "")
    sFName = Replace(sFName, "(", "")
    sFName = Replace(sFName, ")", "")
    sFName = Replace(sFName, ":", "")
    sFName = Replace(sFName, ",", "")
    sFName = Replace(sFName, "/", "")
    sFName = Replace(sFName, "\", "")
    sFName = Replace(sFName, "[", "")
    sFName = Replace(sFName, "]", "")
    sFName = Replace(sFName, "  ", " ")
    sFName = Replace(sFName, "  ", " ")
    tokens = Split(sFName, , , vbTextCompare)
    fname = ""
    limit = UBound(tokens)
    If (limit > max_limit) Then limit = max_limit
    For j = 0 To limit
        fname = fname & tokens(j) 'Join  first max_limit words
    Next
    ' fname = Join(tokens, "_")
    inpname = fname & ".png"
    Do While (fs.FileExists(inpname))   'Avoid file overwrite
        count = count + 1
        inpname = fname & count & ".png"
    Loop
    
    ch.Export Filename:=inpname, FilterName:="PNG"
    If (generate_eps) Then
        If (count = 0) Then outname = fname & ".eps" Else outname = fname & count & ".eps"
        arg = "bmeps -leps2 " & inpname & " " & outname
    Else
        If (count = 0) Then outname = fname & ".bb" Else outname = fname & count & ".bb"
        arg = "bmeps -lbb " & inpname & " " & outname
    End If
    Shell (arg)
    i = i + 1
Next
Set ch = Nothing
End Sub


