Hi All,
I am novice to VBA and trying to learn.
I am creating a simple bar chart and Want to copy the format of the chart and apply to another charts.
i have used code from the peltiertech blog CopyChartFormatsNotTitles2, but some of the formatting is not working when i run the code:
-series color is not getting formatted
- i have used Switched Row/Column while creating the bar chart, this is also not getting mirrored
-Legends not getting mirrored.
Let me know if am not enough clear. I have also attached the chart and sample data that i want to use as base.
and below is the code so far i have tried.
Sub CopyChartFormatsNotTitles2()
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
Sht.Activate
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
' chart title exists
sTitle = .ChartTitle.Characters.Text
End If
If .HasAxis(xlCategory) Then
bXTitle = .Axes(xlCategory).HasTitle
If bXTitle Then
' axis title exists
sXTitle = .Axes(xlCategory).AxisTitle.Characters.Text
End If
End If
If .HasAxis(xlValue) Then
bYTitle = .Axes(xlValue).HasTitle
If bYTitle Then
' axis title exists
sYTitle = .Axes(xlValue).AxisTitle.Characters.Text
End If
End If
' apply formats
chtMaster.ChartArea.Copy
'.Paste Type:=xlFormats
.ChartArea.Select
ActiveSheet.PasteSpecial Format:=2
'ActiveChart.PlotBy = xlRows
' 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
chtMaster.Parent.Parent.Activate
chtMaster.ChartArea.Select
Application.ScreenUpdating = True
End Sub
Bookmarks