Created
July 3, 2017 06:36
-
-
Save ndthanh/4eb5dfbdbec866b7c4346388ff002b36 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sub CopyChartFormats() | |
'Updateby20140219 | |
Dim Ws As Worksheet | |
Dim Cht As ChartObject | |
Dim xChart 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 | |
Dim iSource As Long | |
Dim iTarget As Long | |
Dim iTotal As Long | |
Dim iSeries As Long | |
Dim vSource As Variant | |
Dim vTarget As Variant | |
Application.ScreenUpdating = False | |
Set xChart = Application.ActiveChart | |
iSource = xChart.SeriesCollection.Count | |
Set Ws = Application.ActiveSheet | |
For Each Cht In Ws.ChartObjects | |
If Ws.Name = xChart.Parent.Parent.Name And _ | |
Cht.Name = xChart.Parent.Name Then | |
Else | |
With Cht.Chart | |
iTarget = .SeriesCollection.Count | |
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 | |
xChart.ChartArea.Copy | |
.Paste Type:=xlFormats | |
iTotal = .SeriesCollection.Count | |
If iTotal = iSource + iTarget Then | |
For iSeries = 1 To iTarget | |
vSource = Split(.SeriesCollection(iSeries).Formula, ",") | |
vTarget = Split(.SeriesCollection(iSeries + iSource).Formula, ",") | |
vTarget(UBound(vTarget)) = vSource(UBound(vSource)) | |
.SeriesCollection(iSeries).Formula = Join(vTarget, ",") | |
Next | |
For iSeries = iTotal To iTarget + 1 Step -1 | |
.SeriesCollection(iSeries).Delete | |
Next | |
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 | |
If bTitle Then | |
.HasTitle = True | |
.ChartTitle.Characters.Text = sTitle | |
End If | |
End With | |
End If | |
Next | |
Application.ScreenUpdating = True | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment