I have a similar issue and have almost solved it and some other issues of
chart object placement & sizing. Work in Progress.
Try this and remove items and change paramaters to suit your situation.
Public Sub SetupCharts()
On Error GoTo ErrorHandler
Dim mycharts As Chart
Dim Sheettarget As Excel.Worksheet
Dim lcount As Long
Dim lcharts As Long
If Application.ActiveWorkbook Is Nothing Then
MsgBox gszERR_NO_WORKBOOK, vbCritical, gszAPP_TITLE
Exit Sub
End If
' Gather info about the workbook.
Set Sheettarget = Application.ActiveWorkbook.ActiveSheet
lcharts = Sheettarget.ChartObjects.Count
ChartHeight = 142
ChartWidth = 369
' Set size of charts
For lcount = 1 To lcharts
With Sheettarget.Shapes.Range(lcount)
.Height = ChartHeight
.Width = ChartWidth
End With
With Sheettarget.ChartObjects(lcount).Activate
Sheettarget.ChartObjects(lcount).SendToBack
' Sheettarget.Shapes.Range(lcount).Name = "Chart" & lcount
' Chart AREA
ActiveChart.ChartArea.Select
With Selection
.Interior.Pattern = xlfalse
.Border.LineStyle = xlNone
End With
' Chart TITLE
ActiveChart.ChartTitle.Select
With Selection
.Font.Size = 8
.Font.ColorIndex = 2
.Left = 5
.Top = 0
.HorizontalAlignment = xlCenter
.AutoScaleFont = False
.Interior.Color = RGB(144, 144, 144)
End With
' Chart LEGEND
ActiveChart.Legend.Select
With Selection
.Left = 0
.Width = 400
Dim legendHeight
legendHeight = ActiveChart.SeriesCollection.Count * 11 / 3
.Height = legendHeight
.Top = 15
.AutoScaleFont = False
.Font.Size = 9
.Border.LineStyle = xlNone
.Interior.Pattern = xlfalse
End With
' PLOT AREA
ActiveChart.PlotArea.Select
With Selection
PlotTop = ActiveChart.ChartTitle.Font.Size +
legendHeight + 8
Plotheight = ChartHeight - PlotTop - 5
.Top = PlotTop
.Left = 0
.Width = ChartWidth
.Border.LineStyle = xlNone
.Height = Plotheight
ph = ActiveChart.PlotArea.Height
End With
With Selection.Interior
.ColorIndex = xlNone
End With
' Chart Value AXIS
ActiveChart.Axes(xlValue, xlPrimary).Select
With Selection
.MinorUnitIsAuto = True
'.MajorUnitIsAuto = True
' .MajorUnit = 1000
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
' Chart Secondary Value AXIS
If ActiveChart.Axes.Count > 2 Then
ActiveChart.Axes(xlValue, xlSecondary).Select
With Selection
.TickLabels.NumberFormat = "0%;[Red]-0%"
' .MinimumScale = -5
' .MaximumScale = 5
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MajorUnitIsAuto = True
End With
End If
' Chart Time Scale AXIS
ActiveChart.Axes(xlCategory, xlPrimary).Select
With Selection
.CategoryType = xlAutomatic
.CategoryType = xlTimeScale
Dim timescaleMin As Date
timescaleMin = Range("Fycharts.xls!Minimum_Time_scale")
.MinimumScale = timescaleMin
.MaximumScale = "06/26/2008"
.MinorUnitIsAuto = True
.MajorUnit = 1
.MajorUnitScale = xlMonths
.BaseUnit = xlDays
.BaseUnitIsAuto = False
.Crosses = xlAutomatic
.ReversePlotOrder = False
.AxisBetweenCategories = True
End With
'Repaint all changes to chart
ActiveChart.Refresh
End With
Next lcount
Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
End Sub
Jeff Gross said:
Hi.
I posted this on the chart group but received no response so I thought I
would try here before reposting there.
All files are Excel 2003.
I have a spreadsheet that has several hundred embedded charts. The data
is updated monthly and the charts automatically update themselves. The
problem is that when the data is updated on the charts, the plot area reverts
to some default size which does not take advantage of alot of the chart size.
I don't want to go to each chart every month and manually increase the plot
area. Any ideas?
Thanks.
I'll let you know if I get it to work as well.