View Single Post
  #5  
Old August 18th, 2009, 06:01 PM posted to microsoft.public.excel.charting
Jon Peltier[_2_]
external usenet poster
 
Posts: 386
Default Applying template settings over multiple charts

Try:

For Each Sht In ActiveWorkbook.Worksheets

Also try the amended code I posted to John's blog. Hmmm, looks like he
hasn't gotten my comment. Here's the code:

Sub Copy_Chart_Formats()

Dim Sht As Worksheet
Dim Cht As ChartObject

Application.ScreenUpdating = False

ActiveChart.ChartArea.Copy

For Each Sht In ActiveWorkbook.Worksheets
For Each Cht In Sht.ChartObjects
Cht.Chart.Paste Type:=xlFormats
Next Cht
Next Sht

Application.ScreenUpdating = True

End Sub

As I also mentioned in the comment that's gone AWOL, copying formats
from one chart and pasting them onto another also copies chart and axis
titles, so you may find yourself having to redo 230 sets of titles. You
would have to check for titles, save the text, and reapply them. (Data
labels and shapes are also not properly dealt with, but I'm not
including them in this routine.) The code is something like this:

Sub Copy_Chart_Formats_Not_Titles()

Dim Sht As Worksheet
Dim Cht As ChartObject
Dim chtMaster As Chart
Dim bTitle As Boolean
Dim bXTitle As Boolean
Dim bYTitle As Boolean
Dim sTitle As String
Dim sXTitle As String
Dim sYTitle As String

Application.ScreenUpdating = False

Set chtMaster = ActiveChart

For Each Sht In ActiveWorkbook.Worksheets
For Each Cht In Sht.ChartObjects
If Sht.Name = chtMaster.Parent.Parent.Name And _
Cht.Name = chtMaster.Parent.Name Then
' don't waste time on chtMaster
Else
With Cht.Chart
' get titles
bTitle = .HasTitle
If bTitle Then
sTitle = .ChartTitle.Characters.Text
End If
If .HasAxis(xlCategory) Then
bXTitle = .Axes(xlCategory).HasTitle
If bXTitle Then
sXTitle = .Axes(xlCategory).AxisTitle.Characters.Text
End If
End If
If .HasAxis(xlValue) Then
bYTitle = .Axes(xlValue).HasTitle
If bYTitle Then
sYTitle = .Axes(xlValue).AxisTitle.Characters.Text
End If
End If

' apply formats
chtMaster.ChartArea.Copy
.Paste Type:=xlFormats

' restore titles
If bTitle Then
.HasTitle = True
.ChartTitle.Characters.Text = sTitle
End If
If bXTitle Then
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Characters.Text = sXTitle
End If
If bYTitle Then
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Characters.Text = sYTitle
End If
End With
End If
Next Cht
Next Sht

Application.ScreenUpdating = True

End Sub


- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/


Ian wrote:
I pasted the code in the VB editor and when I went to run the macro in Excel,
it says "Run-time error '13' Type mismatch" When I go to debug, the line of
code "For Each Sht In ActiveWorkbook.Sheets" is highlighted in yellow.

I don't know much about VB; the only code I kind of know is C++ so I
wouldn't know how to fix it. What should I do? Thanks for helping me.

"John Mansfield" wrote:

Assuming all of the charts are embedded charts, you could give a macro like
the one below a try. Copy the procedure into a standard module. Next,
select / activate (click on the outer container) the chart that you consider
your template. Go to Tools - Macro - Macros and run it.

Sub Copy_Chart_Formats()

Dim Sht As Worksheet
Dim Cht As ChartObject

Application.ScreenUpdating = False

ActiveChart.ChartArea.Copy

For Each Sht In ActiveWorkbook.Sheets
Sht.Activate
For Each Cht In ActiveSheet.ChartObjects
Cht.Activate
ActiveChart.Paste Type:=xlFormats
Next Cht
Next Sht

End Sub

As a side note, I don't think it's well written because it activates each
sheet and chart to copy the formats. However, I can't seem to get it to work
any other way without spending more time to experiment.

--
John Mansfield
http://www.cellmatrix.net


"Ian" wrote:

Hi, I have over 230 charts in my workbook. I've modified a template to use
for them. How do I apply it over every single chart instantly without having
to go through each chart and doing it manually? Thanks for any help.