Excel Graphing

[zaza]

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

[zaza]

...and here is setgraphstyle:

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

[Pallavi001]

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 :-)

[si_the_geek]

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.

[zaza]

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...