zaza
Jan 11th, 2006, 02:13 PM
This is some code to aid in the production of Excel graphs. It is intended mainly as a foundation rather than a complete code for all possibilities, as the full range of Excel graphs and their associated requirements are immense. It can be used to display Line graphs, Scatter graphs and Column graphs, and will do much of the formatting (to your specifications).
It is fairly easy to adapt for other graph types and other requirements, such as trendlines etc, can be easily inserted by the user.
Just copy and paste the code to a VBA module.
Coded in Excel XP (2002).
There is also a handy Enum of all the colour codes used by Excel :).
Have fun.
All comments / bugs / suggestions welcome.
zaza
-------------------------------------------------
Usage:
First, call creategraph to set the graph up. Then call setgraphdata to add the data series. Then define any fonts that you wish to use for Main title, axes titles and axes, then call setgraphstyle.
Call creategraph(ActiveSheet, "Bobbins", LineGraph, xlColumns, 200, 200, 400, 300)
Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("C2:C6"), xlPrimary, "Line1", xlMarkerStyleCircle, 6, Blue, Black, xlContinuous, xlThin, Blue, True)
Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("E2:E6"), xlPrimary, "Line2", xlMarkerStyleCircle, 6, Green, Black, xlLineStyleNone, xlThin, Green, True)
Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("G2:G6"), xlPrimary, "Line3", xlMarkerStyleCircle, 6, Red, Black, xlContinuous, xlThin, Red, True)
Dim graphfont As New NewFont
graphfont.Name = "Times New Roman"
graphfont.Size = 12
graphfont.Bold = True
Dim axisfont As New NewFont
axisfont.Name = "Times New Roman"
axisfont.Size = 10
axisfont.Bold = True
Dim datafont As New NewFont
datafont.Name = "Times New Roman"
datafont.Size = 9
datafont.Italic = True
Call setgraphstyle(ActiveSheet, "Bobbins", "My Chart", "x-axis", "y-axis", , White, Black, True, False, graphfont, axisfont, datafont, 0, 6, 0, 25, , , False, False, xlTickMarkInside, xlTickMarkInside)
-------------------------------------------------
Code:
Public Enum Colour 'Colours list
None = -4142
Black = 1
White = 2
Red = 3
BrightGreen = 4
Blue = 5
Yellow = 6
Magenta = 7
Cyan = 8
DarkRed = 9
Green = 10
DarkBlue = 11
DarkYellow = 12
Violet = 13
Teal = 14
Grey25 = 15
Grey50 = 16
Lilac = 17
Cream = 19
DarkViolet = 21
Pink = 22
MidBlue = 23
PaleLavender = 24
SkyBlue = 33
LightCyan = 34
LightGreen = 35
LightYellow = 36
PaleBlue = 37
Rose = 38
Lavender = 39
Tan = 40
LightBlue = 41
Aqua = 42
Lime = 43
Gold = 44
LightOrange = 45
Orange = 46
BlueGrey = 47
Grey40 = 48
DarkTeal = 49
SeaGreen = 50
DarkGreen = 51
Olive = 52
Brown = 53
Plum = 54
Indigo = 55
Grey80 = 56
End Enum
Public Enum chartstyle 'Chart styles
LineGraph = xlLine
ScatterGraph = xlXYScatter
ColumnGraph = xlColumnClustered
End Enum
Sub creategraph(ByVal wksht As Worksheet, ByVal chtname As String, ByVal chttype As chartstyle, ByVal chtplotby As XlRowCol, ByVal chtleft As Double, ByVal chttop As Double, ByVal chtwidth As Double, ByVal chtheight As Double)
'-------------------------------------------------
' Parameters:
'
' Worksheet
' Your choice of chart name
' The chart type
' The left, top, width and height of the chart
'
'-------------------------------------------------
Dim newcht As ChartObject
Set newcht = wksht.ChartObjects.Add(chtleft, chttop, chtwidth, chtheight)
newcht.Name = chtname
newcht.Chart.charttype = chttype
End Sub
Sub setgraphdata(ByVal wksht As Worksheet, ByVal chtname As String, ByVal chtxaxis As Range, ByVal chtyaxis As Range, ByVal chtPS As XlAxisGroup, ByVal chtlinename As String, ByVal chtmarkerstyle As XlMarkerStyle, ByVal chtmarkersize As Integer, ByVal chtmarkerbkcolor As Colour, ByVal chtmarkerfcolor As Colour, ByVal chtline As XlLineStyle, ByVal chtlinewt As XlBorderWeight, ByVal chtlinecol As Colour, ByVal chtlinesmooth As Boolean)
'-------------------------------------------------
' Parameters:
'
' Worksheet
' Chart name
' x-axis range
' y-axis range
' y-axis group
' Name of series for legend
' Point style
' Point size
' Point back colour
' Point fore colour
' Line style
' Line weight
' Line colour
' Smooth? (True/False)
'
'-------------------------------------------------
Dim newcht As ChartObject
Dim ns As Series
Set newcht = wksht.ChartObjects(chtname)
Set ns = newcht.Chart.SeriesCollection.NewSeries
'Set series parameters
If newcht.Chart.charttype <> chartstyle.ColumnGraph Then
With ns
.XValues = chtxaxis
.Values = chtyaxis
.AxisGroup = chtPS
.Name = chtlinename
If chtmarkerstyle <> xlMarkerStyleNone Then
.MarkerBackgroundColorIndex = chtmarkerbkcolor
.MarkerForegroundColorIndex = chtmarkerfcolor
.MarkerStyle = chtmarkerstyle
.MarkerSize = chtmarkersize
End If
.Smooth = chtlinesmooth
End With
'Set linestyle parameters
With ns.Border
.LineStyle = chtline
If chtline <> xlLineStyleNone Then
.ColorIndex = chtlinecol
.Weight = chtlinewt
End If
End With
Else
With ns
.XValues = chtxaxis
.Values = chtyaxis
.AxisGroup = chtPS
.Name = chtlinename
.Interior.ColorIndex = chtmarkerbkcolor
End With
End If
End Sub
It is fairly easy to adapt for other graph types and other requirements, such as trendlines etc, can be easily inserted by the user.
Just copy and paste the code to a VBA module.
Coded in Excel XP (2002).
There is also a handy Enum of all the colour codes used by Excel :).
Have fun.
All comments / bugs / suggestions welcome.
zaza
-------------------------------------------------
Usage:
First, call creategraph to set the graph up. Then call setgraphdata to add the data series. Then define any fonts that you wish to use for Main title, axes titles and axes, then call setgraphstyle.
Call creategraph(ActiveSheet, "Bobbins", LineGraph, xlColumns, 200, 200, 400, 300)
Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("C2:C6"), xlPrimary, "Line1", xlMarkerStyleCircle, 6, Blue, Black, xlContinuous, xlThin, Blue, True)
Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("E2:E6"), xlPrimary, "Line2", xlMarkerStyleCircle, 6, Green, Black, xlLineStyleNone, xlThin, Green, True)
Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("G2:G6"), xlPrimary, "Line3", xlMarkerStyleCircle, 6, Red, Black, xlContinuous, xlThin, Red, True)
Dim graphfont As New NewFont
graphfont.Name = "Times New Roman"
graphfont.Size = 12
graphfont.Bold = True
Dim axisfont As New NewFont
axisfont.Name = "Times New Roman"
axisfont.Size = 10
axisfont.Bold = True
Dim datafont As New NewFont
datafont.Name = "Times New Roman"
datafont.Size = 9
datafont.Italic = True
Call setgraphstyle(ActiveSheet, "Bobbins", "My Chart", "x-axis", "y-axis", , White, Black, True, False, graphfont, axisfont, datafont, 0, 6, 0, 25, , , False, False, xlTickMarkInside, xlTickMarkInside)
-------------------------------------------------
Code:
Public Enum Colour 'Colours list
None = -4142
Black = 1
White = 2
Red = 3
BrightGreen = 4
Blue = 5
Yellow = 6
Magenta = 7
Cyan = 8
DarkRed = 9
Green = 10
DarkBlue = 11
DarkYellow = 12
Violet = 13
Teal = 14
Grey25 = 15
Grey50 = 16
Lilac = 17
Cream = 19
DarkViolet = 21
Pink = 22
MidBlue = 23
PaleLavender = 24
SkyBlue = 33
LightCyan = 34
LightGreen = 35
LightYellow = 36
PaleBlue = 37
Rose = 38
Lavender = 39
Tan = 40
LightBlue = 41
Aqua = 42
Lime = 43
Gold = 44
LightOrange = 45
Orange = 46
BlueGrey = 47
Grey40 = 48
DarkTeal = 49
SeaGreen = 50
DarkGreen = 51
Olive = 52
Brown = 53
Plum = 54
Indigo = 55
Grey80 = 56
End Enum
Public Enum chartstyle 'Chart styles
LineGraph = xlLine
ScatterGraph = xlXYScatter
ColumnGraph = xlColumnClustered
End Enum
Sub creategraph(ByVal wksht As Worksheet, ByVal chtname As String, ByVal chttype As chartstyle, ByVal chtplotby As XlRowCol, ByVal chtleft As Double, ByVal chttop As Double, ByVal chtwidth As Double, ByVal chtheight As Double)
'-------------------------------------------------
' Parameters:
'
' Worksheet
' Your choice of chart name
' The chart type
' The left, top, width and height of the chart
'
'-------------------------------------------------
Dim newcht As ChartObject
Set newcht = wksht.ChartObjects.Add(chtleft, chttop, chtwidth, chtheight)
newcht.Name = chtname
newcht.Chart.charttype = chttype
End Sub
Sub setgraphdata(ByVal wksht As Worksheet, ByVal chtname As String, ByVal chtxaxis As Range, ByVal chtyaxis As Range, ByVal chtPS As XlAxisGroup, ByVal chtlinename As String, ByVal chtmarkerstyle As XlMarkerStyle, ByVal chtmarkersize As Integer, ByVal chtmarkerbkcolor As Colour, ByVal chtmarkerfcolor As Colour, ByVal chtline As XlLineStyle, ByVal chtlinewt As XlBorderWeight, ByVal chtlinecol As Colour, ByVal chtlinesmooth As Boolean)
'-------------------------------------------------
' Parameters:
'
' Worksheet
' Chart name
' x-axis range
' y-axis range
' y-axis group
' Name of series for legend
' Point style
' Point size
' Point back colour
' Point fore colour
' Line style
' Line weight
' Line colour
' Smooth? (True/False)
'
'-------------------------------------------------
Dim newcht As ChartObject
Dim ns As Series
Set newcht = wksht.ChartObjects(chtname)
Set ns = newcht.Chart.SeriesCollection.NewSeries
'Set series parameters
If newcht.Chart.charttype <> chartstyle.ColumnGraph Then
With ns
.XValues = chtxaxis
.Values = chtyaxis
.AxisGroup = chtPS
.Name = chtlinename
If chtmarkerstyle <> xlMarkerStyleNone Then
.MarkerBackgroundColorIndex = chtmarkerbkcolor
.MarkerForegroundColorIndex = chtmarkerfcolor
.MarkerStyle = chtmarkerstyle
.MarkerSize = chtmarkersize
End If
.Smooth = chtlinesmooth
End With
'Set linestyle parameters
With ns.Border
.LineStyle = chtline
If chtline <> xlLineStyleNone Then
.ColorIndex = chtlinecol
.Weight = chtlinewt
End If
End With
Else
With ns
.XValues = chtxaxis
.Values = chtyaxis
.AxisGroup = chtPS
.Name = chtlinename
.Interior.ColorIndex = chtmarkerbkcolor
End With
End If
End Sub