Multiple charts Macro


Posted by Tamara on June 01, 2000 2:57 AM

I have had problems creating a Macro that produces series of charts.

I have on each sheet 2 sections of data in which each section consists of 2 columns A:B (10 Rows in depth)

(The 1st section of data = A5:B14. The 2nd section of data = A16:B25).

The amount of sheets in the WorkBook can vary.

I need a Macro that will create 2 "Area" graphs from the data specified on each WorkBook until there is no more data available.

Also added in the 1st chart a Title "Revenue" in the Y axis and in the 2nd chart "Minutes" again in the Y axis. (Deleted = the Chart Title on both and the legend on top)

Can this be done? The other problem is that I need to then reduce the size of the chart and its final position.


Is this impossible? Is this clear enough?

Thanks to anyone who can help.

Tamara

Posted by Ivan Moala on June 03, 0100 5:59 AM

Sorry
Slight Adj on this;
This is the one.

Option Explicit
Dim x As Integer
Dim y As Integer
Dim ChtObj 'New Chart Object
Dim MyBook As String 'Activeworkbook Name
Dim ShCount 'Number of sheets
Dim MyRg As String 'your data range
Dim SpaceGrf As Integer 'Spacegrf = space between graphs when creating
Dim msg As String 'General message string

'=======Change these value to put the chart in a diff position=========
Const ChtLeft = 270 'Left position of chart from cell A1
Const ChtTop = 95 'Top position of Chart from cell A1
Const ChtWidth = 270 'Width of Chart (in points)
Const ChtHeight = 180 'Height of Chart (in point)

Sub CreatArea_Graphs()
'********************************************
'* *
'* CreatArea_Graphs Macro *
'* Macro created 02-06-2000 by Ivan F Moala *
'* *
'********************************************


MyBook = ActiveWorkbook.Name
ShCount = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False

For x = 1 To ShCount
Sheets(x).Activate
If Range("A5") = "" Then GoTo NoData
For y = 1 To 2
MyRg = "A5:B14": If y = 2 Then MyRg = "A16:B25"
Set ChtObj = Sheets(x).ChartObjects.Add(ChtLeft, ChtTop + SpaceGrf, ChtWidth, ChtHeight)
ChtObj.Chart.ChartWizard Source:=Sheets(x).Range(MyRg), PlotBy:= _
xlColumns, Gallery:=xlArea
With ChtObj.Chart
.HasTitle = True
.ChartTitle.Characters.Text = "Deleted"
.ChartTitle.Font.Name = "Arial"
.ChartTitle.Font.Size = 10
'Do Title
.Axes(xlValue, xlPrimary).



Posted by Ivan Moala on June 02, 0100 10:38 PM

Hi Tamara
Have a look at this;
Also added a delete charts routine so that
you can play around with the positioning
and change the settings to get it right, then
hard code the constants.

HTH

Ivan


Option Explicit
Dim x As Integer
Dim y As Integer
Dim ChtObj 'New Chart Object
Dim MyBook As String 'Activeworkbook Name
Dim ShCount 'Number of sheets
Dim MyRg As String 'your data range
Dim SpaceGrf As Integer 'Spacegrf = space between graphs when creating
Dim msg As String 'General message string

'=======Change these value to put the chart in a diff position=========
Const ChtLeft = 270 'Left position of chart from cell A1
Const ChtTop = 95 'Top position of Chart from cell A1
Const ChtWidth = 270 'Width of Chart (in points)
Const ChtHeight = 180 'Height of Chart (in point)

Sub CreatArea_Graphs()
'********************************************
'*