martinctc
4/28/2017 - 8:40 AM

Copies the property of the first selected chart to the second. e.g. Height, Width, Axis scale, etc.

Copies the property of the first selected chart to the second. e.g. Height, Width, Axis scale, etc.

Chart Copier.vbs
content_copyfile_download
Function VBA_Long_To_RGB(lColor As Long) As String
    Dim iRed, iGreen, iBlue
    
    'Convert Decimal Color Code to RGB
    iRed = (lColor Mod 256)
    iGreen = (lColor / 256) Mod 256
    iBlue = (lColor / 65536) Mod 256
    
    'Return RGB Code
    VBA_Long_To_RGB = "(" & iRed & "," & iGreen & "," & iBlue & ")"
End Function
Sub ChartCopier()

'Copies the property of the first selected chart to the second
'No variables are saved into the memory

Dim shp1, shp2 As Shape
Dim i, j, k As Long

Set shp1 = ActiveWindow.Selection.ShapeRange(1)
Set shp2 = ActiveWindow.Selection.ShapeRange(2)
i = 1
j = shp2.Chart.FullSeriesCollection.Count
Debug.Print j


shp2.Height = shp1.Height
shp2.Width = shp1.Width

If shp1.Chart.HasAxis(xlValue) = True Then
    shp2.Chart.HasAxis(xlValue) = True
    shp2.Chart.Axes(xlValue).MinimumScale = shp1.Chart.Axes(xlValue).MinimumScale
    shp2.Chart.Axes(xlValue).MaximumScale = shp1.Chart.Axes(xlValue).MaximumScale
Else: shp2.Chart.HasAxis(xlValue) = False
End If

If shp1.Chart.HasAxis(xlCategory) = True Then
    shp2.Chart.HasAxis(xlCategory) = True
    shp2.Chart.Axes(xlCategory).MinimumScale = shp1.Chart.Axes(xlCategory).MinimumScale
    shp2.Chart.Axes(xlCategory).MaximumScale = shp1.Chart.Axes(xlCategory).MaximumScale
Else: shp2.Chart.HasAxis(xlCategory) = False
End If

If shp1.Chart.HasLegend = True Then
    shp2.Chart.HasLegend = True
Else: shp2.Chart.HasLegend = False
End If

For i = 1 To j
    shp2.Chart.FullSeriesCollection(i).Format.Fill.Visible = shp1.Chart.FullSeriesCollection(i).Format.Fill.Visible
    shp2.Chart.FullSeriesCollection(i).Format.Line.Visible = shp1.Chart.FullSeriesCollection(i).Format.Line.Visible
    'shp2.Chart.FullSeriesCollection(i).Format.Fill.ForeColor.RGB = "RGB" & VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Fill.ForeColor.RGB)
    Debug.Print "ForeColor Fill: " & shp1.Chart.FullSeriesCollection(i).Format.Fill.ForeColor.RGB
    Debug.Print "BackColor Fill: " & shp1.Chart.FullSeriesCollection(i).Format.Fill.BackColor.RGB
    Debug.Print "ForeColor Line: " & shp1.Chart.FullSeriesCollection(i).Format.Line.ForeColor.RGB
    Debug.Print "BackColor Line: " & shp1.Chart.FullSeriesCollection(i).Format.Line.BackColor.RGB
    Debug.Print "ForeColor Fill: " & VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Fill.ForeColor.RGB)
    Debug.Print "BackColor Fill: " & VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Fill.BackColor.RGB)
    Debug.Print "ForeColor Line: " & VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Line.ForeColor.RGB)
    Debug.Print "BackColor Line: " & VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Line.BackColor.RGB)
    shp2.Chart.FullSeriesCollection(i).Format.Fill.ForeColor.RGB = VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Fill.ForeColor.RGB)
    'shp2.Chart.FullSeriesCollection(i).Format.Fill.BackColor.RGB = VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Fill.BackColor.RGB)
    shp2.Chart.FullSeriesCollection(i).Format.Line.ForeColor.RGB = VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Line.ForeColor.RGB)
    'shp2.Chart.FullSeriesCollection(i).Format.Line.BackColor.RGB = VBA_Long_To_RGB(shp1.Chart.FullSeriesCollection(i).Format.Line.BackColor.RGB)
    shp2.Chart.FullSeriesCollection(i).HasLeaderLines = shp1.Chart.FullSeriesCollection(i).HasLeaderLines
    If shp1.Chart.FullSeriesCollection(i).HasDataLabels = True And shp2.Chart.FullSeriesCollection(i).HasDataLabels = False Then
        Debug.Print "Yes"
        shp2.Chart.FullSeriesCollection(i).ApplyDataLabels
        shp2.Chart.FullSeriesCollection(i).DataLabels.NumberFormat = shp1.Chart.FullSeriesCollection(i).DataLabels.NumberFormat
        shp2.Chart.FullSeriesCollection(i).DataLabels.ShowSeriesName = shp1.Chart.FullSeriesCollection(i).DataLabels.ShowSeriesName
        shp2.Chart.FullSeriesCollection(i).DataLabels.ShowSeriesName = shp1.Chart.FullSeriesCollection(i).DataLabels.ShowSeriesName
        shp2.Chart.FullSeriesCollection(i).DataLabels.ShowValue = shp1.Chart.FullSeriesCollection(i).DataLabels.ShowValue
    End If
Next

End Sub