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 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" wrote:

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.

Thanks a lot for the feedback. I had to put this issue on the backburner and
am working on another issue but I hope to be back on this issue within the
next few weeks. I'll take your code and work with it - it is quite detailed
:) I'll let you know if I get it to work as well.

Again, thanks.

Jeff

"Graham Tritton" wrote:

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" wrote:

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.

This was the modified code I used from your example - thanks a huge - it
works great!.

Public Sub SetupCharts()
'This code will force all charts to be the same size and format.

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 = 325
ChartWidth = 790

'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 - OK
ActiveChart.ChartArea.Select
With Selection
.Interior.Pattern = Solid
.Interior.Color = RGB(255, 255, 255)
.Border.LineStyle = Solid
.Border.ColorIndex = 1
End With

'Chart TITLE - OK
ActiveChart.ChartTitle.Select
With Selection
.Font.Size = 12
.Font.ColorIndex = 1
' .Left = 190
.Top = 0
.HorizontalAlignment = xlCenter
.AutoScaleFont = False
.Interior.Color = RGB(255, 255, 255)
End With

'Chart LEGEND - OK
ActiveChart.Legend.Select
With Selection
.AutoScaleFont = False
.Font.Size = 9
.Border.LineStyle = Solid
.Border.Color = 1
.Interior.Pattern = Solid
.Interior.Color = RGB(255, 255, 255)
End With

'Plot AREA - OK
ActiveChart.PlotArea.Select
With Selection
PlotTop = ActiveChart.ChartTitle.Font.Size + 15
Plotheight = ChartHeight - PlotTop - 10
.Top = PlotTop
.Left = 20
.Width = ChartWidth - 60
.Border.LineStyle = Solid
.Border.Color = 1
.Height = Plotheight
ph = ActiveChart.PlotArea.Height
.Interior.Pattern = Solid
.Interior.Color = RGB(192, 192, 192)
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



Again, thanks a lot.