Thread: [Solved] Chart code for automation
View Single Post
 
Old 04-16-2013, 03:03 AM
OTPM OTPM is offline Windows 7 32bit Office 2010 32bit
Expert
 
Join Date: Apr 2011
Location: West Midlands
Posts: 981
OTPM is on a distinguished road
Default

Hi
If the code you have pasted is exactly what is in your Module then there are a number of spacing errors. I have corrected them in this codeset below. Cut and paste this codeset into your module to replace the curret and see if that resolves your issue:

Function CreateBarCharts() AsBoolean
Dim myChtObj AsChartObject
Dim rngChtData AsRange
Dim rngChtXVal AsRange
Dim iColumn AsLong

Dim sheetName AsString
sheetName = "DataSource"
Dim WSD AsWorksheet
Set WSD = Worksheets(sheetName)

Dim chartSheet AsString
chartSheet = "ChartOutput"
Dim CSD As Worksheet
Set CSD = Worksheets(chartSheet)

' get the current charts so proper overwriting can happen
Dim chtObjs As ChartObjects
Set chtObjs = CSD.ChartObjects

' Turn off autofilter mode
WSD.AutoFilterMode = False

' Find the last row with data
Dim finalRow As Long
finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row

Dim i As Integer

' for each row in the sheet
For i = 2 To finalRow

Dim chartName As String
chartName = WSD.Cells(i, 5).Value

' Delete chart if it already exists, we are making a new one
Dim chtObj As ChartObject
For Each chtObj InchtObjs
If chtObj.Name = chartName Then
chtObj.Delete
EndIf
Next

' define chart data range for the row (record)
Dim dataString As String
dataString = "C"& i & ""& i
Set rngChtData = WSD.Range(dataString)

' define the x values
Set rngChtXVal = WSD.Range("$C$1:$D$1")

' add the chart
Charts.Add
With ActiveChart

' make a bar chart
.ChartType = xlColumnClustered

' remove extra series
DoUntil .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop



' add series from selected range, column by column

With .SeriesCollection.NewSeries
.Values = rngChtData
.XValues = rngChtXVal
.Name = "Cost"
End With

.Location Where:=xlLocationAsObject, Name:=chartSheet
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Benefits Cost"
.Parent.Name = WSD.Cells(i, 5).Value
.Legend.Delete

.Axes(xlCategory).TickLabels.AutoScaleFont = False
With .Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

.Axes(xlValue).TickLabels.AutoScaleFont = False
With .Axes(xlValue).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

.ChartTitle.AutoScaleFont = False
With .ChartTitle.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
EndWith

With .PlotArea.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
End With

' Set the height and width
With CSD.ChartObjects(chartName)
.Width = 225
.Height = 175
End With
Next i
End Function

There may still be some errors in the code. If so then post it on the Programming section of the Excel forum and I am sure someone will respond.

Good luck.

Tony
Reply With Quote