-
Jan 11th, 2006, 03:13 PM
#1
Excel Graphing
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.
VB Code:
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:
VB 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
Last edited by zaza; Sep 5th, 2006 at 03:46 PM.
-
Jan 11th, 2006, 03:14 PM
#2
Re: Excel Graphing
...and here is setgraphstyle:
VB Code:
Sub setgraphstyle(ByVal wksht As Worksheet, ByVal chtname As String, ByVal chttitle As String, ByVal chtxtitle As String, ByVal chtytitle As String, Optional ByVal chtytitle2 As String, Optional ByVal chtbkcol As Colour, Optional ByVal chtbordercol As Colour, Optional ByVal chtlegend As Boolean, Optional ByVal chtlegbord As Boolean, Optional ByVal chttitlefont As NewFont, Optional chtaxisfont As NewFont, Optional ByVal chtdatafont As NewFont, Optional ByVal xmin As String, Optional ByVal xmax As String, Optional ByVal ymin As String, Optional ByVal ymax As String, Optional ByVal ymin2 As String, Optional ByVal ymax2 As String, Optional ByVal xgrid As Boolean, Optional ByVal ygrid As Boolean, Optional ByVal majtick As XlTickMark, Optional ByVal mintick As XlTickMark)
On Error Resume Next
'-------------------------------------------------
' Parameters:
'
' Worksheet
' Chart name
' Chart title
' x-axis title
' y-axis title
' Back colour
' Border colour
' Legend? (True/False)
' Legend border
' Chart title font
' Axis title font
' Axis and Legend font
' Min and max of x, y, second y axes
' Gridlines
' Tickmarks
'
'-------------------------------------------------
Dim newcht As ChartObject
Set newcht = wksht.ChartObjects(chtname)
'Define a general font
Dim genfont As New NewFont
genfont.Name = "Arial"
genfont.Size = 10
genfont.Bold = False
genfont.Italic = False
genfont.Underline = False
'Tidy up missing parameters
If chttitlefont Is Nothing Then Set chttitlefont = genfont
If chtaxisfont Is Nothing Then Set chtaxisfont = genfont
If chtdatafont Is Nothing Then Set chtdatafont = genfont
If chtbkcol = 0 Then chtbkcol = White
If chtbordercol = 0 Then chtbordercol = Black
'Set Title
If chttitle <> "" Then
newcht.Chart.HasTitle = True
newcht.Chart.ChartTitle.Text = chttitle
newcht.Chart.ChartTitle.Font.Name = chttitlefont.Name
newcht.Chart.ChartTitle.Font.Size = chttitlefont.Size
newcht.Chart.ChartTitle.Font.Bold = chttitlefont.Bold
newcht.Chart.ChartTitle.Font.Italic = chttitlefont.Italic
newcht.Chart.ChartTitle.Font.Underline = chttitlefont.Underline
End If
'Set Axis titles
If chtxtitle <> "" Then
newcht.Chart.Axes(xlCategory).HasTitle = True
newcht.Chart.Axes(xlCategory).AxisTitle.Caption = chtxtitle
newcht.Chart.Axes(xlCategory).AxisTitle.Font.Name = chtaxisfont.Name
newcht.Chart.Axes(xlCategory).AxisTitle.Font.Size = chtaxisfont.Size
newcht.Chart.Axes(xlCategory).AxisTitle.Font.Bold = chtaxisfont.Bold
newcht.Chart.Axes(xlCategory).AxisTitle.Font.Italic = chtaxisfont.Italic
newcht.Chart.Axes(xlCategory).AxisTitle.Font.Underline = chtaxisfont.Underline
End If
If chtytitle <> "" Then
newcht.Chart.Axes(xlValue).HasTitle = True
newcht.Chart.Axes(xlValue).AxisTitle.Caption = chtytitle
newcht.Chart.Axes(xlValue).AxisTitle.Font.Name = chtaxisfont.Name
newcht.Chart.Axes(xlValue).AxisTitle.Font.Size = chtaxisfont.Size
newcht.Chart.Axes(xlValue).AxisTitle.Font.Bold = chtaxisfont.Bold
newcht.Chart.Axes(xlValue).AxisTitle.Font.Italic = chtaxisfont.Italic
newcht.Chart.Axes(xlValue).AxisTitle.Font.Underline = chtaxisfont.Underline
End If
If chtytitle2 <> "" Then
newcht.Chart.Axes(xlValue, xlSecondary).HasTitle = True
newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Caption = chtytitle2
newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Name = chtaxisfont.Name
newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Size = chtaxisfont.Size
newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Bold = chtaxisfont.Bold
newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Italic = chtaxisfont.Italic
newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Underline = chtaxisfont.Underline
End If
'Set axis data fonts
With newcht.Chart.Axes(xlCategory).TickLabels.Font
.Name = chtdatafont.Name
.Size = chtdatafont.Size
.Bold = chtdatafont.Bold
.Italic = chtdatafont.Italic
.Underline = chtdatafont.Underline
End With
With newcht.Chart.Axes(xlValue).TickLabels.Font
.Name = chtdatafont.Name
.Size = chtdatafont.Size
.Bold = chtdatafont.Bold
.Italic = chtdatafont.Italic
.Underline = chtdatafont.Underline
End With
If chtytitle2 <> "" Then
With newcht.Chart.Axes(xlValue, xlSecondary).TickLabels.Font
.Name = chtdatafont.Name
.Size = chtdatafont.Size
.Bold = chtdatafont.Bold
.Italic = chtdatafont.Italic
.Underline = chtdatafont.Underline
End With
End If
'Set chart interior and border
newcht.Chart.PlotArea.Interior.ColorIndex = chtbkcol
newcht.Chart.PlotArea.Border.ColorIndex = chtbordercol
'Set Legend
newcht.Chart.HasLegend = chtlegend
If chtlegend = True Then
newcht.Chart.Legend.Border.LineStyle = chtlegbord
newcht.Chart.Legend.Font.Name = chtdatafont.Name
newcht.Chart.Legend.Font.Size = chtdatafont.Size
newcht.Chart.Legend.Font.Bold = chtdatafont.Bold
newcht.Chart.Legend.Font.Italic = chtdatafont.Italic
newcht.Chart.Legend.Font.Underline = chtdatafont.Underline
End If
'Set chart axis limits
If xmin <> "" Then
newcht.Chart.Axes(xlCategory).MinimumScale = Val(xmin)
Else
newcht.Chart.Axes(xlCategory).MinimumScaleIsAuto = True
End If
If xmax <> "" Then
newcht.Chart.Axes(xlCategory).MaximumScale = Val(xmax)
Else
newcht.Chart.Axes(xlCategory).MaximumScaleIsAuto = True
End If
If ymin <> "" Then
newcht.Chart.Axes(xlValue).MinimumScale = Val(ymin)
Else
newcht.Chart.Axes(xlValue).MinimumScaleIsAuto = True
End If
If ymax <> "" Then
newcht.Chart.Axes(xlValue).MaximumScale = Val(ymax)
Else
newcht.Chart.Axes(xlValue).MaximumScaleIsAuto = True
End If
If ymin2 <> "" Then
newcht.Chart.Axes(xlValue, xlSecondary).MinimumScale = Val(ymin2)
Else
newcht.Chart.Axes(xlValue, xlSecondary).MinimumScaleIsAuto = True
End If
If ymax2 <> "" Then
newcht.Chart.Axes(xlValue, xlSecondary).MaximumScale = Val(ymax2)
Else
newcht.Chart.Axes(xlValue, xlSecondary).MaximumScaleIsAuto = True
End If
'Set gridlines
If xgrid <> "" Then
newcht.Chart.Axes(xlCategory).HasMajorGridlines = xgrid
Else
newcht.Chart.Axes(xlCategory).HasMajorGridlines = False
End If
If ygrid <> "" Then
newcht.Chart.Axes(xlValue).HasMajorGridlines = ygrid
Else
newcht.Chart.Axes(xlValue).HasMajorGridlines = False
End If
'Set tickmarks
newcht.Chart.Axes(xlCategory).MajorTickMark = majtick
newcht.Chart.Axes(xlCategory).MinorTickMark = mintick
newcht.Chart.Axes(xlValue).MajorTickMark = majtick
newcht.Chart.Axes(xlValue).MinorTickMark = mintick
If chtytitle2 <> "" Then
newcht.Chart.Axes(xlValue, xlSecondary).MajorTickMark = majtick
newcht.Chart.Axes(xlValue, xlSecondary).MinorTickMark = mintick
End If
End Sub
-
Jan 2nd, 2008, 04:33 AM
#3
Member
Re: Excel Graphing
Please tell me,
What are the project references you have added?
What are the import statements?
because i'm getting error "not declared" for many terms.
I have added Microsoft Excel 11.0 Object Library
and import statement -- Imports Microsoft.Office.Interop
Thanks :-)
-
Jan 2nd, 2008, 12:31 PM
#4
Re: Excel Graphing
This forum is for Visual Basic 6 and earlier, and you seem to be using VB.Net (VB 2002 or later), so this example is not usable without modifications.
It would be best to ask in the .Net forum (or perhaps Office Development) for what Imports etc you need.
-
Jan 3rd, 2008, 05:37 PM
#5
Re: Excel Graphing
This was coded in Excel itself, so obviously is in a somewhat different language. However, I think you can clear most of the errors out by adding references to Excel 10.0 and Office 10.0, and Import Excel at the top.
Then you'll need to qualify the chart styles with XlChartType, the markers with XlMarkerStyle, the linestyles with XlLineStyle and the axes with XlAxisType.
And you'll need to change the colour enumeration.
But i think that should at least remove the errors. See how you go...
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|