Using VBA to format Charts and Chart Objects

I am using Excel 2013 Charting and I am trying to standardize the formatting across a number of my charts. After I have completed 20 or 30 charts, I find there are inconsistencies across the different type of charts as to font size and type, bolding, thickness of lines, bar chart outlines, chart and axis titles, etc.

I tried recording a number of macros that would take the active chart or chart object and format everything on it, but they don't work consistently across my charts. I use bar chart macros on bar charts, line chart macros on line charts, etc.

Some examples of what I would like to accomplish are:

• All fonts New Times Roman
• All fonts bold
• All fonts a minimum of 12 points
• Color bars that have a black 1.5 point black outline
• Line charts where all the lines are smoothed and the lines are 1.5 point thickness
• Outside tick marks on all axis
• Data labels turned on and oval shapes used with white fill and TNR 12 point bold
• Chart titles TNR minimum 24 point bold
• Axis titles TNR 14 point bold

Would anyone have some code that would at least show me how to access the properties of the active Chart or Chart object. If I could at least address all text and make it TNR 12 point bold, I would be grateful. Given an example of that, I could probably figure out the rest.

Thanks,

Tom

Thanks humdingaling,

When I said "all fonts", I was referring to:

• Chart Title
• Axis Titles
• Axis units (both axis)
• Legend
• Data Labels

One thing I was dealing with was how to recognize if the chart is a chart sheet or if the chart is a chart object embedded in the sheet along with data. There seems to be a difference in how you reference each and what properties to use.

One very frustrating thing I noticed was that if I changed the data labels to ovals (with white fill and black outline), if I had previously formatted the numbers in the data labels, Excel would throw out my previous formatting and I had to start all over. One VBA subroutine I tried to build was to take all data labels on the chart or chart object and make them oval, TNR, 12 point, bold, white fill, black outline and autofitted. I recorded my action on one series but had a problem getting it to work on the other series.

Here are 4 statements I tried to get my data labels to autosize but none of them would work:

    
    ActiveChart.FullSeriesCollection(2).DataLabels.AutoSize = True
    ActiveChart.Shapes.AutoSize = True
    Selection.AutoFit = True   ' I had the series selected.
    Selection.AutoFit              ' Same here

My ideal goal is to eventually build a subroutine that will go sheet by sheet and apply the above formatting to every chart and chart object so that the entire collection of charts are consistent.

Any suggestions would for any of the above would be appreciated.

Thanks,

Tom

I tried Jon's vba and it worked but where I had 2 values, I got 4 and all the colors were different. The fonts were cloned, though.

I went back and tried the subroutine "Copy_Chart_Formats". It errored on "ActiveSheet.PasteSpecial Format:=2" with the error "Object doesn't support this property or method".

Sorry for the multiple replies. I keep thinking of things to say after I send.

On Jon's code, where my master chart had 2 series and the target chart has 2 series, the target chart ends up with 4 series after running Jon's code.

I didn't read far enough down Jon's blog to see that he revised his code. When I run the following code, it does not double the number of series, however, it only works on Chart Objects, not Chart Sheets. I don't know why.

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
  
  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 chtMaster = ActiveChart
  iSource = chtMaster.SeriesCollection.Count

  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
          ' count series
          iTarget = .SeriesCollection.Count
          ' 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

          ' restore data (2007 and 2010 bug:
          ' paste-special-formats treated as paste-special-all)
          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
          
          ' 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

humdingaling,

Thanks for putting me on to Jon's website!

I just modified Jon's code so that it handles Chart Objects and Chart Sheets. I used a blunt force method of repeating the code for the Chart Objects and modifying it so that handles Chart sheets also.

Now, if I could figure out how to keep the code from changing the chart type to the same chart type as the master and just format the text in the Titles, data labels and axis units, I would be all set. Any thoughts?

Sub Copy_Chart_Formats_Not_Titles()

  Dim Sht As Worksheet
  Dim Cht As ChartObject
  Dim oChart As Chart
  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
  
  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 chtMaster = ActiveChart
  iSource = chtMaster.SeriesCollection.Count

  For Each Sht In ActiveWorkbook.Worksheets
'    Debug.Print
'    Debug.Print Sht.Name
'    Debug.Print Sht.ChartObjects.Count
'    Debug.Print
'    Debug.Print Sht.Charts.Count
  
    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
          ' count series
          iTarget = .SeriesCollection.Count
          ' 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

          ' restore data (2007 and 2010 bug:
          ' paste-special-formats treated as paste-special-all)
          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
          
          ' 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

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

  Set chtMaster = ActiveChart
  iSource = chtMaster.SeriesCollection.Count

  For Each Sht In ActiveWorkbook.Worksheets
'    Debug.Print
'    Debug.Print Sht.Name
'    Debug.Print ActiveWorkbook.Charts.Count
'    Debug.Print
'    Debug.Print Sht.Charts.Count
  
    For Each oChart In ActiveWorkbook.Charts
      If Sht.Name = chtMaster.Parent.Parent.Name And _
          oChart.Name = chtMaster.Parent.Name Then
        ' don't waste time on chtMaster
      Else
'        With oChart.Chart
        With oChart
          ' count series
          iTarget = .SeriesCollection.Count
          ' 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

          ' restore data (2007 and 2010 bug:
          ' paste-special-formats treated as paste-special-all)
          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
          
          ' 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 oChart
  Next Sht

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Application.ScreenUpdating = True

End Sub

I am trying this out in 2010 on my home computer. I had the master chart selected when I ran the code.

PS. I was using:

ActiveSheet.PasteSpecial Format:=2

I am not sure how to mark this thread as "solved". I did not see a control that would do it.

I finally found it. Could it be because the control to mark things "solved" is so hard to find that there aren't more of these threads marked "solved"?