Results 1 to 5 of 5

Thread: Excel Graphing

  1. #1

    Thread Starter
    Frenzied Member zaza's Avatar
    Join Date
    Apr 2001
    Location
    Borneo Rainforest Habits: Scratching
    Posts
    1,486

    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:
    1. Call creategraph(ActiveSheet, "Bobbins", LineGraph, xlColumns, 200, 200, 400, 300)
    2.    
    3.     Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("C2:C6"), xlPrimary, "Line1", xlMarkerStyleCircle, 6, Blue, Black, xlContinuous, xlThin, Blue, True)
    4.     Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("E2:E6"), xlPrimary, "Line2", xlMarkerStyleCircle, 6, Green, Black, xlLineStyleNone, xlThin, Green, True)
    5.     Call setgraphdata(ActiveSheet, "Bobbins", Range("B2:B6"), Range("G2:G6"), xlPrimary, "Line3", xlMarkerStyleCircle, 6, Red, Black, xlContinuous, xlThin, Red, True)
    6.  
    7.     Dim graphfont As New NewFont
    8.     graphfont.Name = "Times New Roman"
    9.     graphfont.Size = 12
    10.     graphfont.Bold = True
    11.    
    12.     Dim axisfont As New NewFont
    13.     axisfont.Name = "Times New Roman"
    14.     axisfont.Size = 10
    15.     axisfont.Bold = True
    16.    
    17.     Dim datafont As New NewFont
    18.     datafont.Name = "Times New Roman"
    19.     datafont.Size = 9
    20.     datafont.Italic = True
    21.  
    22.     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:
    1. Public Enum Colour  'Colours list
    2.     None = -4142
    3.     Black = 1
    4.     White = 2
    5.     Red = 3
    6.     BrightGreen = 4
    7.     Blue = 5
    8.     Yellow = 6
    9.     Magenta = 7
    10.     Cyan = 8
    11.     DarkRed = 9
    12.     Green = 10
    13.     DarkBlue = 11
    14.     DarkYellow = 12
    15.     Violet = 13
    16.     Teal = 14
    17.     Grey25 = 15
    18.     Grey50 = 16
    19.     Lilac = 17
    20.     Cream = 19
    21.     DarkViolet = 21
    22.     Pink = 22
    23.     MidBlue = 23
    24.     PaleLavender = 24
    25.     SkyBlue = 33
    26.     LightCyan = 34
    27.     LightGreen = 35
    28.     LightYellow = 36
    29.     PaleBlue = 37
    30.     Rose = 38
    31.     Lavender = 39
    32.     Tan = 40
    33.     LightBlue = 41
    34.     Aqua = 42
    35.     Lime = 43
    36.     Gold = 44
    37.     LightOrange = 45
    38.     Orange = 46
    39.     BlueGrey = 47
    40.     Grey40 = 48
    41.     DarkTeal = 49
    42.     SeaGreen = 50
    43.     DarkGreen = 51
    44.     Olive = 52
    45.     Brown = 53
    46.     Plum = 54
    47.     Indigo = 55
    48.     Grey80 = 56
    49. End Enum
    50.  
    51. Public Enum chartstyle  'Chart styles
    52.     LineGraph = xlLine
    53.     ScatterGraph = xlXYScatter
    54.     ColumnGraph = xlColumnClustered
    55. End Enum
    56.  
    57. 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)
    58.    
    59.     '-------------------------------------------------
    60.     '   Parameters:
    61.     '
    62.     '   Worksheet
    63.     '   Your choice of chart name
    64.     '   The chart type
    65.     '   The left, top, width and height of the chart
    66.     '
    67.     '-------------------------------------------------
    68.    
    69.    
    70.     Dim newcht As ChartObject
    71.    
    72.     Set newcht = wksht.ChartObjects.Add(chtleft, chttop, chtwidth, chtheight)
    73.     newcht.Name = chtname
    74.     newcht.Chart.charttype = chttype
    75.    
    76.    
    77. End Sub
    78.  
    79.  
    80. 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)
    81.  
    82.     '-------------------------------------------------
    83.     '   Parameters:
    84.     '
    85.     '   Worksheet
    86.     '   Chart name
    87.     '   x-axis range
    88.     '   y-axis range
    89.     '   y-axis group
    90.     '   Name of series for legend
    91.     '   Point style
    92.     '   Point size
    93.     '   Point back colour
    94.     '   Point fore colour
    95.     '   Line style
    96.     '   Line weight
    97.     '   Line colour
    98.     '   Smooth? (True/False)
    99.     '
    100.     '-------------------------------------------------
    101.    
    102.    
    103.    
    104.     Dim newcht As ChartObject
    105.     Dim ns As Series
    106.    
    107.     Set newcht = wksht.ChartObjects(chtname)
    108.     Set ns = newcht.Chart.SeriesCollection.NewSeries
    109.  
    110.  
    111.     'Set series parameters
    112.    
    113.     If newcht.Chart.charttype <> chartstyle.ColumnGraph Then
    114.    
    115.         With ns
    116.             .XValues = chtxaxis
    117.             .Values = chtyaxis
    118.             .AxisGroup = chtPS
    119.             .Name = chtlinename
    120.             If chtmarkerstyle <> xlMarkerStyleNone Then
    121.                 .MarkerBackgroundColorIndex = chtmarkerbkcolor
    122.                 .MarkerForegroundColorIndex = chtmarkerfcolor
    123.                 .MarkerStyle = chtmarkerstyle
    124.                 .MarkerSize = chtmarkersize
    125.             End If
    126.             .Smooth = chtlinesmooth
    127.         End With
    128.      
    129.    
    130.         'Set linestyle parameters
    131.         With ns.Border
    132.             .LineStyle = chtline
    133.             If chtline <> xlLineStyleNone Then
    134.                 .ColorIndex = chtlinecol
    135.                 .Weight = chtlinewt
    136.             End If
    137.         End With
    138.  
    139.     Else
    140.    
    141.         With ns
    142.             .XValues = chtxaxis
    143.             .Values = chtyaxis
    144.             .AxisGroup = chtPS
    145.             .Name = chtlinename
    146.             .Interior.ColorIndex = chtmarkerbkcolor
    147.         End With
    148.    
    149.     End If
    150.  
    151. End Sub
    Last edited by zaza; Sep 5th, 2006 at 03:46 PM.

  2. #2

    Thread Starter
    Frenzied Member zaza's Avatar
    Join Date
    Apr 2001
    Location
    Borneo Rainforest Habits: Scratching
    Posts
    1,486

    Re: Excel Graphing

    ...and here is setgraphstyle:


    VB Code:
    1. 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)
    2.  
    3.     On Error Resume Next
    4.  
    5.     '-------------------------------------------------
    6.     '   Parameters:
    7.     '
    8.     '   Worksheet
    9.     '   Chart name
    10.     '   Chart title
    11.     '   x-axis title
    12.     '   y-axis title
    13.     '   Back colour
    14.     '   Border colour
    15.     '   Legend? (True/False)
    16.     '   Legend border
    17.     '   Chart title font
    18.     '   Axis title font
    19.     '   Axis and Legend font
    20.     '   Min and max of x, y, second y axes
    21.     '   Gridlines
    22.     '   Tickmarks
    23.     '
    24.     '-------------------------------------------------
    25.  
    26.  
    27.     Dim newcht As ChartObject
    28.    
    29.     Set newcht = wksht.ChartObjects(chtname)
    30.    
    31.     'Define a general font
    32.     Dim genfont As New NewFont
    33.     genfont.Name = "Arial"
    34.     genfont.Size = 10
    35.     genfont.Bold = False
    36.     genfont.Italic = False
    37.     genfont.Underline = False
    38.    
    39.    
    40.     'Tidy up missing parameters
    41.     If chttitlefont Is Nothing Then Set chttitlefont = genfont
    42.     If chtaxisfont Is Nothing Then Set chtaxisfont = genfont
    43.     If chtdatafont Is Nothing Then Set chtdatafont = genfont
    44.    
    45.     If chtbkcol = 0 Then chtbkcol = White
    46.     If chtbordercol = 0 Then chtbordercol = Black
    47.    
    48.    
    49.     'Set Title
    50.     If chttitle <> "" Then
    51.         newcht.Chart.HasTitle = True
    52.         newcht.Chart.ChartTitle.Text = chttitle
    53.         newcht.Chart.ChartTitle.Font.Name = chttitlefont.Name
    54.         newcht.Chart.ChartTitle.Font.Size = chttitlefont.Size
    55.         newcht.Chart.ChartTitle.Font.Bold = chttitlefont.Bold
    56.         newcht.Chart.ChartTitle.Font.Italic = chttitlefont.Italic
    57.         newcht.Chart.ChartTitle.Font.Underline = chttitlefont.Underline
    58.     End If
    59.    
    60.    
    61.     'Set Axis titles
    62.     If chtxtitle <> "" Then
    63.         newcht.Chart.Axes(xlCategory).HasTitle = True
    64.         newcht.Chart.Axes(xlCategory).AxisTitle.Caption = chtxtitle
    65.         newcht.Chart.Axes(xlCategory).AxisTitle.Font.Name = chtaxisfont.Name
    66.         newcht.Chart.Axes(xlCategory).AxisTitle.Font.Size = chtaxisfont.Size
    67.         newcht.Chart.Axes(xlCategory).AxisTitle.Font.Bold = chtaxisfont.Bold
    68.         newcht.Chart.Axes(xlCategory).AxisTitle.Font.Italic = chtaxisfont.Italic
    69.         newcht.Chart.Axes(xlCategory).AxisTitle.Font.Underline = chtaxisfont.Underline
    70.     End If
    71.     If chtytitle <> "" Then
    72.         newcht.Chart.Axes(xlValue).HasTitle = True
    73.         newcht.Chart.Axes(xlValue).AxisTitle.Caption = chtytitle
    74.         newcht.Chart.Axes(xlValue).AxisTitle.Font.Name = chtaxisfont.Name
    75.         newcht.Chart.Axes(xlValue).AxisTitle.Font.Size = chtaxisfont.Size
    76.         newcht.Chart.Axes(xlValue).AxisTitle.Font.Bold = chtaxisfont.Bold
    77.         newcht.Chart.Axes(xlValue).AxisTitle.Font.Italic = chtaxisfont.Italic
    78.         newcht.Chart.Axes(xlValue).AxisTitle.Font.Underline = chtaxisfont.Underline
    79.     End If
    80.     If chtytitle2 <> "" Then
    81.         newcht.Chart.Axes(xlValue, xlSecondary).HasTitle = True
    82.         newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Caption = chtytitle2
    83.         newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Name = chtaxisfont.Name
    84.         newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Size = chtaxisfont.Size
    85.         newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Bold = chtaxisfont.Bold
    86.         newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Italic = chtaxisfont.Italic
    87.         newcht.Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Underline = chtaxisfont.Underline
    88.     End If
    89.    
    90.    
    91.     'Set axis data fonts
    92.     With newcht.Chart.Axes(xlCategory).TickLabels.Font
    93.         .Name = chtdatafont.Name
    94.         .Size = chtdatafont.Size
    95.         .Bold = chtdatafont.Bold
    96.         .Italic = chtdatafont.Italic
    97.         .Underline = chtdatafont.Underline
    98.     End With
    99.    
    100.     With newcht.Chart.Axes(xlValue).TickLabels.Font
    101.         .Name = chtdatafont.Name
    102.         .Size = chtdatafont.Size
    103.         .Bold = chtdatafont.Bold
    104.         .Italic = chtdatafont.Italic
    105.         .Underline = chtdatafont.Underline
    106.     End With
    107.    
    108.     If chtytitle2 <> "" Then
    109.     With newcht.Chart.Axes(xlValue, xlSecondary).TickLabels.Font
    110.         .Name = chtdatafont.Name
    111.         .Size = chtdatafont.Size
    112.         .Bold = chtdatafont.Bold
    113.         .Italic = chtdatafont.Italic
    114.         .Underline = chtdatafont.Underline
    115.     End With
    116.     End If
    117.    
    118.     'Set chart interior and border
    119.     newcht.Chart.PlotArea.Interior.ColorIndex = chtbkcol
    120.     newcht.Chart.PlotArea.Border.ColorIndex = chtbordercol
    121.    
    122.    
    123.     'Set Legend
    124.     newcht.Chart.HasLegend = chtlegend
    125.     If chtlegend = True Then
    126.         newcht.Chart.Legend.Border.LineStyle = chtlegbord
    127.         newcht.Chart.Legend.Font.Name = chtdatafont.Name
    128.         newcht.Chart.Legend.Font.Size = chtdatafont.Size
    129.         newcht.Chart.Legend.Font.Bold = chtdatafont.Bold
    130.         newcht.Chart.Legend.Font.Italic = chtdatafont.Italic
    131.         newcht.Chart.Legend.Font.Underline = chtdatafont.Underline
    132.     End If
    133.  
    134.    
    135.     'Set chart axis limits
    136.     If xmin <> "" Then
    137.         newcht.Chart.Axes(xlCategory).MinimumScale = Val(xmin)
    138.     Else
    139.         newcht.Chart.Axes(xlCategory).MinimumScaleIsAuto = True
    140.     End If
    141.     If xmax <> "" Then
    142.         newcht.Chart.Axes(xlCategory).MaximumScale = Val(xmax)
    143.     Else
    144.         newcht.Chart.Axes(xlCategory).MaximumScaleIsAuto = True
    145.     End If
    146.     If ymin <> "" Then
    147.         newcht.Chart.Axes(xlValue).MinimumScale = Val(ymin)
    148.     Else
    149.         newcht.Chart.Axes(xlValue).MinimumScaleIsAuto = True
    150.     End If
    151.     If ymax <> "" Then
    152.         newcht.Chart.Axes(xlValue).MaximumScale = Val(ymax)
    153.     Else
    154.         newcht.Chart.Axes(xlValue).MaximumScaleIsAuto = True
    155.     End If
    156.     If ymin2 <> "" Then
    157.         newcht.Chart.Axes(xlValue, xlSecondary).MinimumScale = Val(ymin2)
    158.     Else
    159.         newcht.Chart.Axes(xlValue, xlSecondary).MinimumScaleIsAuto = True
    160.     End If
    161.     If ymax2 <> "" Then
    162.         newcht.Chart.Axes(xlValue, xlSecondary).MaximumScale = Val(ymax2)
    163.     Else
    164.         newcht.Chart.Axes(xlValue, xlSecondary).MaximumScaleIsAuto = True
    165.     End If
    166.  
    167.  
    168.     'Set gridlines
    169.     If xgrid <> "" Then
    170.         newcht.Chart.Axes(xlCategory).HasMajorGridlines = xgrid
    171.     Else
    172.         newcht.Chart.Axes(xlCategory).HasMajorGridlines = False
    173.     End If
    174.     If ygrid <> "" Then
    175.         newcht.Chart.Axes(xlValue).HasMajorGridlines = ygrid
    176.     Else
    177.         newcht.Chart.Axes(xlValue).HasMajorGridlines = False
    178.     End If
    179.    
    180.    
    181.     'Set tickmarks
    182.     newcht.Chart.Axes(xlCategory).MajorTickMark = majtick
    183.     newcht.Chart.Axes(xlCategory).MinorTickMark = mintick
    184.     newcht.Chart.Axes(xlValue).MajorTickMark = majtick
    185.     newcht.Chart.Axes(xlValue).MinorTickMark = mintick
    186.     If chtytitle2 <> "" Then
    187.     newcht.Chart.Axes(xlValue, xlSecondary).MajorTickMark = majtick
    188.     newcht.Chart.Axes(xlValue, xlSecondary).MinorTickMark = mintick
    189.     End If
    190.    
    191. End Sub

  3. #3
    Member
    Join Date
    Dec 2007
    Posts
    49

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

  4. #4
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,929

    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.

  5. #5

    Thread Starter
    Frenzied Member zaza's Avatar
    Join Date
    Apr 2001
    Location
    Borneo Rainforest Habits: Scratching
    Posts
    1,486

    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...
    I use VB 6, VB.Net 2003 and Office 2010



    Code:
    Excel Graphing | Excel Timer | Excel Tips and Tricks | Add controls in Office | Data tables in Excel | Gaussian random number distribution (VB6/VBA,VB.Net) | Coordinates, Vectors and 3D volumes

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width