PDA

View Full Version : [SOLVED] Save charts of a workbook into another new workbook



minghong
08-01-2005, 08:42 AM
Hello! All. I want to save some charts in an Excel file(workbook1) into a new Excel file(workbook2) and save the new Excel file as a new name and in a fixed location of some folder. Could anybody give me some suggestions? Thanks in advance! : pray2:

MWE
08-01-2005, 09:24 AM
Hello! All. I want to save some charts in an Excel file(workbook1) into a new Excel file(workbook2) and save the new Excel file as a new name and in a fixed location of some folder. Could anybody give me some suggestions? Thanks in advance! : pray2:
do you wish to do this "manually" or do you wish to develop some VBA code to do it "automatically" (perhaps with some manual intervention)?

minghong
08-01-2005, 09:43 AM
I wish to develop some VBA code to do it automatically. Since I want to do it within a loop, I prefer there's no manual intervention. Thanks!

minghong
08-01-2005, 07:30 PM
Could anybody give me any suggestions? Thanks!

geekgirlau
08-01-2005, 09:24 PM
Could you attach a sample workbook?

minghong
08-01-2005, 09:39 PM
I can give an example. I have a Excel file named " Results1" and there're about three charts in it. Say chart1, chart2 and chart3. What I want to do is copy and save those charts into a new Excel file and name it as" Charts output1" in a particular folder. The reason of why I name these two files with a number 1 is because I need to do a loop to repeat the " copy and save" process to deal with around 100 files. Thanks!

geekgirlau
08-01-2005, 09:44 PM
The first step is to record a macro to copy 1 chart. Select Tools | Macro | Record New macro. Give your macro a name, then step through the process of copying a chart, pasting into a new workbook and saving the result. Then we can have a look at setting up the loop.

Justinlabenne
08-01-2005, 09:53 PM
Are these chart-sheets or chart objects on a worksheet?

BlueCactus
08-01-2005, 10:11 PM
The first step is to record a macro to copy 1 chart. Select Tools | Macro | Record New macro. Give your macro a name, then step through the process of copying a chart, pasting into a new workbook and saving the result. Then we can have a look at setting up the loop.
Probably going to have to copy the source data too, then break the link between the duplicate chart and the original sheet. Can get a little tedious.

minghong
08-02-2005, 02:05 PM
Thanks, Geekgirlar! I will try that.
They are all chart sheets. Justin!
Nice suggestion! BlueCactus.

Justinlabenne
08-02-2005, 06:24 PM
This is a start: it delinks the charts when they get copied to the new workbook, but I am quite sure you will need a different naming sequence when saving the new workbook because it is set up to just name the new workbook the same every time, which will overwrite the previous workbook, so let me know if this works for you and what mods are required.


Option Explicit

Sub CopyChartsToNewBookAndDelinkThemToo()
Dim Cht As Chart
Dim oCht As ChartObject
Dim oSeries As Series
Dim wks As Worksheet
Dim CurSht As String
CurSht = ActiveSheet.Name
With Application.ScreenUpdating = False
For Each Cht In ThisWorkbook.Charts
Cht.Select False
Next Cht
ActiveWindow.SelectedSheets.Copy
For Each Cht In ActiveWorkbook.Charts
For Each oSeries In Cht.SeriesCollection
With oSeries
.Name = .Name
.Values = .Values
.XValues = .XValues
End With
Next
Next
For Each wks In ActiveWorkbook.Worksheets
If wks.Type <> xlChart Then
Application.DisplayAlerts = False
wks.Delete
End If
Next wks
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Charts1.xls"
.Close
End With
Sheets(CurSht).Select
With Application.ScreenUpdating = True
End Sub

minghong
08-03-2005, 02:05 PM
This is a start: it delinks the charts when they get copied to the new workbook, but I am quite sure you will need a different naming sequence when saving the new workbook because it is set up to just name the new workbook the same every time, which will overwrite the previous workbook, so let me know if this works for you and what mods are required.


Option Explicit

Sub CopyChartsToNewBookAndDelinkThemToo()
Dim Cht As Chart
Dim oCht As ChartObject
Dim oSeries As Series
Dim wks As Worksheet
Dim CurSht As String
CurSht = ActiveSheet.Name
With Application.ScreenUpdating = False
For Each Cht In ThisWorkbook.Charts
Cht.Select False
Next Cht
ActiveWindow.SelectedSheets.Copy
For Each Cht In ActiveWorkbook.Charts
For Each oSeries In Cht.SeriesCollection
With oSeries
.Name = .Name
.Values = .Values
.XValues = .XValues
End With
Next
Next
For Each wks In ActiveWorkbook.Worksheets
If wks.Type <> xlChart Then
Application.DisplayAlerts = False
wks.Delete
End If
Next wks
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Charts1.xls"
.Close
End With
Sheets(CurSht).Select
With Application.ScreenUpdating = True
End Sub



Thank you so much! Justin. When I try to run this sample program, it stopped at the With statement ( I marked it as red in the code) and I got a error massage " Compile error: With object must be user-defined type, Object or Variant" . I never use With this way before, so I don't know what's wrong here. Thank you again!

Justinlabenne
08-03-2005, 03:01 PM
Jeez... I was having a bad day.:banghead:

Try like this with no "Withs"


Option Explicit

Sub CopyChartsToNewBookAndDelinkThemToo()
Dim Cht As Chart
Dim oCht As ChartObject
Dim oSeries As Series
Dim wks As Worksheet
Dim CurSht As String
CurSht = ActiveSheet.Name
Application.ScreenUpdating = False
For Each Cht In ThisWorkbook.Charts
Cht.Select False
Next Cht
ActiveWindow.SelectedSheets.Copy
For Each Cht In ActiveWorkbook.Charts
For Each oSeries In Cht.SeriesCollection
With oSeries
.Name = .Name
.Values = .Values
.XValues = .XValues
End With
Next
Next
For Each wks In ActiveWorkbook.Worksheets
If wks.Type <> xlChart Then
Application.DisplayAlerts = False
wks.Delete
End If
Next wks
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Charts1.xls"
.Close
End With
Sheets(CurSht).Select
Application.ScreenUpdating = True
End Sub

JonPeltier
08-13-2005, 12:20 PM
I can copy those charts in one line:


ActiveWorkbook.Charts.Copy

This makes copies of all of the chart sheets, and puts them into a new workbook, without any worksheets. There is no delinking of the charts from the source data, of course, and no save-as code. You can use Justin's.

minghong
08-13-2005, 12:48 PM
Hi! Jon, thank you for your reply! Actually, I do need to delink the charts from the source data and save them into a new workbook with a new name, cause when I run the program using different data series sets, the worksheets and charts in the original workbook will be updated with time. When I run Justin's example, I can not find where the new workbook saved, i.e. I need to give a fixed path of folder to save those new workbooks or a massagebox for users to input a path they want to save them. Thank you all!

JonPeltier
08-13-2005, 01:54 PM
Based on Justin's procedure, here's how you could do this. I'll add a little documentation too, which is out of character, but I'll make an exception just this once.



Option Explicit

Sub CopyChartsToNewBookAndDelinkThemToo2()
Dim Cht As Chart
Dim oSeries As Series
Dim wks As Worksheet
Application.ScreenUpdating = False
' This copies the charts all to a new workbook
' The new workbook becomes the active workbook
ActiveWorkbook.Charts.Copy
' This unlinks each chart from the data
' Warning: if there are many points (like 40-50)
' or data contains many significant digits,
' this part can produce errors.
For Each Cht In ActiveWorkbook.Charts
For Each oSeries In Cht.SeriesCollection
With oSeries
.Name = .Name
.Values = .Values
.XValues = .XValues
End With
Next
Next
' This is where the new workbook is saved and closed
' Insert your own mechanism for defining a path and filename
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Charts1.xls"
.Close
End With
Application.ScreenUpdating = True
End Sub

minghong
08-13-2005, 05:42 PM
Thank you so much, Jon! Your explanation is crystal. I'll try that and if I get something, I'll let you know. Thank you!!!