Article ID: 123260
Article Last Modified on 6/11/2007
Sub gantt_chart()
Dim rge As Variant
Dim mn As Variant
Dim shtname As Variant
'defines the variables
rge = Selection.Address()
'get the cell address
mn = Selection.Offset(1, 1)
'return the min value for the scale
Title = InputBox("Please enter the title")
'Asks the user for title
shtname = ActiveSheet.Name
'retains the name of current sheet
Application.ScreenUpdating=False
'Turns screen updating off
Charts.Add
'Create a paper model chart
ActiveChart.ChartWizard Source:=Sheets(shtname).Range(rge), _
Gallery:=xlBar, Format:=3, PlotBy:=xlColumns, CategoryLabels _
:=1, SeriesLabels:=1, HasLegend:=1, Title:=Title, _
CategoryTitle:="", ValueTitle:="", _
ExtraTitle:=""
' Basic chart definition
ActiveChart.Legend.Delete
'deletes the legend
ActiveChart.SeriesCollection(1).Select
'activates series 1
With Selection.Border
.Weight = xlThin
.LineStyle = xlNone
End With
'definition for the border for series 1
Selection.InvertIfNegative = False
'turns Invert if negative to false
Selection.Interior.ColorIndex = xlNone
'indicates that the area is set to none
ActiveChart.PlotArea.Select
'select the chart plot area
ActiveChart.Axes(xlCategory).Select
'select axis(1)
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.TickLabelSpacing = 1
.TickMarkSpacing = 1
.AxisBetweenCategories = True
End With
'axis 1 definition
ActiveChart.Axes(xlValue).Select
'select axis(2)
With ActiveChart.Axes(xlValue)
.MinimumScale = mn
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = False
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
' Axis(2) definition
End Sub
A1: B1: START C1: DAYS D1: DAYS
A2: TASK B2: DATE C2: COMPLETED D2: REMAINING
A3: TASK-1 B3: 1/1/91 C3: 150 D3: 15
A4: TASK-2 B4: 5/1/91 C4: 21 D4: 31
A5: TASK-3 B5: 7/1/91 C5: 0 D5: 114
A6: TASK-4 B6: 10/1/91 C6: 0 D6: 4
A7: TASK-5 B7: 10/15/91 C7: 0 D7: 31
A8: TASK-6 B8: 11/1/91 C8: 0 D8: 2Additional query words: 97 gannt XL
Keywords: kbprogramming KB123260