Save Charts to individual files (Excel 97 SR-2)

Topic

New Reply

I have a coworker that gets workbooks that contain many charts (most are linked to a different file that he does not get).
The number of charts varies. He needs to make a seperate file for each chart. I showed him how to right click on the tab and select move/copy and check the copy box -then indicate make new file. The problem is, there are many charts. He wants the new workbooks all saved to a temp directory and have the workbooks named in such a way as to incorporate the Tab name and a certain date into the file name. As he gets the original files from another source, I would like the macro to be designed to run from his Personal.xls. We will be distributing the individual files to the people that need them and they will be told to NOT update links when requested on opening.

Wish list:
01) Macro to be located in Personal.xls
02) Macro user asked if path for saving files needs to be changed (prefer the path to be maintained in Personal.xls -should never change)
03) Macro user asked once to enter the date to use as part of the new file names
04) Macro will process all Charts (each on its own sheet in the source file) -creating and saving a new individual file for each Chart
05) Macro names new workbooks incorporating date (as entered by user -above) and Tab name from source file
Sample of new file name 20040528Greenwood.xls (year 2004, month 5, day 28, Tab was named Greenwood)
06) As each chart is copied and saved with new name, close that file so when all have been processed only the source file is in memory (along with Personal.xls)
I am attaching a small sample file (most will have over 30 Charts).

Thank you for your efforts.

Reply | Quote

Replies

Does this do what you want?

Steve

Option Explicit
Sub SaveCharts()
    Dim strPath As String
    Dim cht As Chart
    Dim wkb As Workbook
    Dim sResponse As String
    Dim dDate As Date
    Set wkb = ActiveWorkbook

    strPath = Application.GetOpenFilename _
        (Title:="Choose a file in the Folder to you want to save in")
    If strPath = "False" Then
        MsgBox "Canceled by User"
        Exit Sub
    End If
    Do Until Right(strPath, 1) = ""
        strPath = Mid(strPath, 1, Len(strPath) - 1)
    Loop
    
    Do
        Err.Clear
        sResponse = InputBox("Please enter a date")
        If sResponse = "" Then
            MsgBox "Canceled by User"
            Exit Sub
        End If
        On Error Resume Next
        dDate = DateValue(sResponse)
    Loop Until Err.Number = 0
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    For Each cht In wkb.Charts
        cht.Copy
        With ActiveWorkbook
            .SaveAs strPath & _
                Format(dDate, "yyyymmdd") & cht.Name & ".xls"
            .Close
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Reply | Quote

Steve,

I will save the macro to my PERSONAL.xls, open one of the source files and give a run.

Thanks,
Chuck

Reply | Quote

Steve,

I will save the macro to my PERSONAL.xls, open one of the source files and give a run.

Thanks,
Chuck

Reply | Quote

Steve,

It worked -No surprise there.
Thank you VERY much.

Chuck

Reply | Quote

Steve,

It worked -No surprise there.
Thank you VERY much.

Chuck

Reply | Quote

Edited by Reimer -I figured out a way to do it. No need to waste time on reply, but THANKS

The macro runs GREAT and does exactly what the user wanted (then).
Now the user would like the macro to also save the data sheet that is in the same workbook as the charts, to the same directory the new charts are saved to. The naming convention can be the same as it is for the charts. There may be other sheets (blank or other uses) in the workbook. Since the tab name of the data sheet may change each time, I cannot test for Sheet name to determine which is the data sheet. I will just instruct the user to make sure the sheet active is the data sheet. But, I would like to change the code to determine if the active sheet is a chart or sheet and if it is a chart – warn the user to rerun the macro after making the data sheet active.
What is the VBA code to test the active sheet to see if it is a chart?

Thanks

Reply | Quote

Does this do what you want?

Steve

Option Explicit
Sub SaveCharts()
    Dim strPath As String
    Dim cht As Chart
    Dim wkb As Workbook
    Dim sResponse As String
    Dim dDate As Date
    Set wkb = ActiveWorkbook

    strPath = Application.GetOpenFilename _
        (Title:="Choose a file in the Folder to you want to save in")
    If strPath = "False" Then
        MsgBox "Canceled by User"
        Exit Sub
    End If
    Do Until Right(strPath, 1) = ""
        strPath = Mid(strPath, 1, Len(strPath) - 1)
    Loop
    
    Do
        Err.Clear
        sResponse = InputBox("Please enter a date")
        If sResponse = "" Then
            MsgBox "Canceled by User"
            Exit Sub
        End If
        On Error Resume Next
        dDate = DateValue(sResponse)
    Loop Until Err.Number = 0
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    For Each cht In wkb.Charts
        cht.Copy
        With ActiveWorkbook
            .SaveAs strPath & _
                Format(dDate, "yyyymmdd") & cht.Name & ".xls"
            .Close
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Reply | Quote