VBA

     Chart Object Information                      Chart List                 Freeze Chart Text Size          Size & Align Charts

I created a desktop link to this file and use it often to help me figure out some issue or other with the incredibly complicated Chart Object Model.

I read several books on VBA programming and was always confused about which sub objects belong to which object and how properties and methods fit into the picture. I really believe that I could have reduced my VBA - Chart learning curve if I had started with Excel's help file.

The file includes a hyperlinked Chart Object Model that you can use to navigate to specific chart elements to see how they relate to other chart elements and to view sample VBA code

 If you click on an object, say Plot Area, you get detailed information on the PlotArea Object as shown in the graphic below. If you press the Multiple Objects box, it lists the sub objects of the Plot Area. You can then hyperlink to the sub objects.

This procedure counts the number of chartobjects on the activesheet and then prepares a list of all charts, listing the chart name, index, top and left position as well as chart width and height.

Public Sub chart_list()
Dim chtobj As ChartObject
Dim Msg As String
Dim n As Integer
n = ActiveSheet.ChartObjects.Count
Msg = "Chart List for Sheet " & vbTab & ActiveSheet.Name & vbTab & "No charts = " & n & vbCrLf & vbCrLf
Msg = Msg & "Name " & vbTab & vbTab & "Index" & vbTab & "Top Pos" & vbTab & "Left Pos " & vbTab & "Width " & vbTab & "Height" & vbCrLf
For Each chtobj In ActiveSheet.ChartObjects
cht_width = chtobj.Width
cht_height = chtobj.Height
Top_Position = chtobj.Top
Left_Position = chtobj.Left
Msg = Msg & chtobj.Name & vbTab & vbTab & chtobj.Index & vbTab & Top_Position & vbTab & Left_Position & vbTab & cht_width & vbTab & cht_height & vbCrLf
Next chtobj
out = MsgBox(Msg, , "Chart List")
End Sub

Excel's chart text format has a property to enable auto scaling so that the font is changed whenever the chart size changes. This can be a nuisance in cases where you have a nice chart format that you do not want adjusted when you tweak the chart size.

Jon Peltier has good discussion of this issue http://peltiertech.com/Excel/Charts/FixFonts.html.

Here is a simple VBA procedure to count the number of embedded charts on the  activesheet, cycle through each sheet and set autoscale to false.

  Public Sub Freeze_text()
  Dim chtobj As ChartObject
  Dim Msg As String
  Dim n As Integer
  n = ActiveSheet.ChartObjects.Count
  'Msg = "There are " & n & " charts " & vbNewLine
  For Each chtobj In ActiveSheet.ChartObjects
  With chtobj.Chart.ChartArea
      .AutoScaleFont = False
  End With
  Next chtobj
  End Sub

Do you have several embedded charts on a worksheet? Do you want to line them up vertically or display them in a matrix 3 across by 4 down?

The Size_Align_Charts procedure counts the number of charts on your activesheet, freezes chart text font size,  asks User for number of charts across,  desired chart width and height in points and start cell for chart placement. Based on these User specifications, procedure sizes and aligns charts.

Chrt_size_align.xls includes an example of this procedure as well as the freeze font procedure.

Sub Size_align_charts()
'Procedure to size and align embedded charts on active worksheet
' Developed by D. Kelly O'Day, ProcessTrends.Com
' User specifies: Number of charts across (1 to max )
' Chart width - points
' Chart Height - points
' User selects start cell for charts
' Procedure automatically freezes text size to avoid distorting text as charts resized
Dim chrt_width As Single
Dim chrt_height As Single
Dim Chrts_across As Long
Dim Chrt_cnt As Long
Dim i As Integer
Dim Start_Top As Single
Dim Start_Left As Single
Chrt_cnt = ActiveSheet.ChartObjects.Count
'  Check to see if charts on sheet - terminate if no charts
If Chrt_cnt = 0 Then
     MsgBox ("No charts on sheet. Terminating.")
     End
End If
Call Freeze_text ' Procedure to freeze text to for all charts on active sheet
Chrts_across = InputBox("How many charts across do you wants?", "Charts Across", , 0, 0)
chrt_width = InputBox("Enter Chart Width - Points?", "Chart Width - Points", , 0, 0)
chrt_height = InputBox("Enter Chart Height - Points", "Chart Height - Points", , 0, 0)
Set start_cell = Application.InputBox(prompt:="Select start celll for chart(s)", Type:=8)
On Error GoTo 0
If start_cell Is Nothing Then
     MsgBox "You did not select a cell. Exiting procedure."
     End
End If
' Go to start_cell range
Application.Goto reference:=start_cell
     Start_Top = start_cell.Top
     Start_Left = start_cell.Left
' Loop through all charts on active sheet
For i = 1 To Chrt_cnt
      With ActiveSheet.ChartObjects(i)
        .Width = chrt_width
        .Height = chrt_height
         v = i - 1
        .Left = Start_Left + (v Mod Chrts_across) * chrt_width
       .Top = Start_Top + Int((i - 1) / Chrts_across) * chrt_height
    End With
Next
Range("a1").Select
End Sub