[RESOLVED] Excel - VBA - Gradient fills (on graphs)
Hi
I'm looking into the topic title, mainly to make the auto generated reports look a bit, well, different. Can't really say better ;)
Anyway, after browsing msdn, its not being too forth-coming on how to use the gradient fill (more the custom percentage and colours). Recording a macro resulted in a very unhelpful one line. Like the record macro for this bit is not working properly.
Does anyone have any links to places on line to read up on this (preferrably with an example) or have any examples they can post.
I'm using this as an object from Access, but for testing I am running inside Excel.
Code I've got so far below (based off of recorded macro)
Description of sheet beneath the code...
Thanks in advance
Code:
Public Sub t()
Dim wrk As Workbook
Dim sht As Worksheet
Dim rng As Range
Dim shp As Shape
Dim cht As Chart
Dim srs As Series
Dim strCell As String
Dim lngMaxCol As Long
Dim lngSRow As Long
Dim lngStartRow As Long
Dim lngCost As Long
lngMaxCol = 14
lngSRow = 8
lngStartRow = 8
lngCost = 0
Set wrk = ActiveWorkbook
Set sht = ActiveSheet
Set cht = wrk.Charts.Add
cht.ChartType = xlLine
Set srs = cht.SeriesCollection.NewSeries
'---- no of claims
Set rng = sht.Cells(lngSRow + 1, 2)
strCell = "'" & sht.Name & "'!" & rng.AddressLocal(True, True)
srs.Name = "=" & strCell
Set rng = sht.Range(sht.Cells(lngSRow + 1, 3), sht.Cells(lngSRow + 1, lngMaxCol))
strCell = "'" & sht.Name & "'!" & rng.AddressLocal(True, True)
srs.Values = "=" & strCell
srs.ChartType = 51 'xlColumnClustered
cht.ChartGroups(1).GapWidth = 30
With srs.Format.Fill
.Visible = msoTrue
' .GradientAngle = 90 '?
.GradientStyle = msoGradientVertical
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0.3399999738
.ForeColor.Brightness = 0
.BackColor.ObjectThemeColor = msoThemeColorAccent1
.BackColor.TintAndShade = 0.7649999857
.BackColor.Brightness = 0
.TwoColorGradient msoGradientVertical, 1
End With
'---- titles aren't moving, this time...
Set rng = sht.Range(sht.Cells(lngStartRow - 1, 3), sht.Cells(lngStartRow, lngMaxCol))
strCell = "'" & sht.Name & "'!" & rng.AddressLocal(True, True)
srs.XValues = "=" & strCell 'needs a series to add the xvalues to...
'---- cost / avg cost
Set srs = cht.SeriesCollection.NewSeries
Set rng = sht.Cells(lngSRow + 2 + lngCost, 2)
strCell = "'" & sht.Name & "'!" & rng.AddressLocal(True, True)
srs.Name = "=" & strCell
Set rng = sht.Range(sht.Cells(lngSRow + 2 + lngCost, 3), sht.Cells(lngSRow + 2 + lngCost, lngMaxCol))
strCell = "'" & sht.Name & "'!" & rng.AddressLocal(True, True)
srs.Values = "=" & strCell
srs.AxisGroup = 2
srs.ChartType = 4 'xlline
srs.Format.Line.ForeColor.RGB = RGB(230, 0, 0)
srs.Format.Line.DashStyle = msoLineSysDash
srs.Format.Line.Weight = 1.75
Set rng = sht.Cells(lngSRow, 2)
strCell = "'" & sht.Name & "'!" & rng.AddressLocal(True, True)
cht.HasTitle = True
cht.ChartTitle.Text = "=" & strCell
cht.Axes(xlCategory).HasTitle = True
cht.Axes(xlCategory).AxisTitle.Text = "Bottom Axis Title"
cht.Axes(xlValue).HasTitle = True
cht.Axes(xlValue).AxisTitle.Text = "Left Axis Title"
cht.Axes(xlValue, 2).HasTitle = True
cht.Axes(xlValue, 2).AxisTitle.Text = "Right (secondary) Axis Title"
cht.Legend.Position = -4107 'xlLegendPositionBottom
cht.Location Where:=xlLocationAsObject, Name:="Sheet1"
End Sub
Sheet data is :
row 7 - year (column C and if required elsewhere)
row 8 - titles, B (Area) , C-N (Months)
Row 9 - occurrances
Row 10 - costs
Row 11 - avg cost
Re: Excel - VBA - Gradient fills (on graphs)
Also, The bit I've got in there to add a new empty chart, excel is now auto adding in the series from the cells (first pass does occurrances vs cost, second pass does occurrances vs average) even though I've not asked it to. First pass it auto added an empty series.
Is this normal ?
Re: Excel - VBA - Gradient fills (on graphs)
The annoyances of Excel...
Not much documentation available, however the following code seems to do the job. So I just need to tweak it. Posting here incase anyone else gets problems with gradients (custom).
Note, it mentions something about a none linear color mix, following a path. No idea how that works...
The following code needs a sheet (selected when run) and a Chart (as a tab not an object).
Code:
Public Sub t()
'http://msdn.microsoft.com/en-us/library/office/ff838979%28v=office.15%29.aspx
Dim wrk As Workbook
Dim sht As Worksheet
Dim rng As Range
Dim cht As Chart
Dim ff As FillFormat
Dim ser As Series
Dim gst As GradientStop
Dim lngL As Long
Set wrk = ActiveWorkbook
Set sht = ActiveSheet
Set cht = wrk.Charts(1)
Set ser = cht.SeriesCollection(1)
Set ff = ser.Format.Fill
'ff.Solid
'ff.OneColorGradient msoGradientHorizontal, 1
ff.TwoColorGradient msoGradientVertical, 1
ff.ForeColor.RGB = RGB(255, 0, 0)
ff.ForeColor.Brightness = 0.75
ff.BackColor.RGB = RGB(0, 0, 255)
ff.BackColor.Brightness = 0.75
'most of gradient stuff is read only
'but needs to be a gradient before you can mess with it
'---- checks for existing extra gradients, minimum 2 stops (otherwise errors)
If ff.GradientStops.Count > 2 Then
For lngL = ff.GradientStops.Count To 3 Step -1
ff.GradientStops.Delete lngL
Next
End If
ff.GradientStops.Insert RGB(0, 255, 0), 1, 1, 2
Set gst = ff.GradientStops(1)
gst.Transparency = 0
gst.Position = 0
gst.Color.RGB = RGB(255, 0, 0)
gst.Color.Brightness = 0.25
gst.Color.TintAndShade = 0.25
Set gst = ff.GradientStops(2)
gst.Transparency = 0
gst.Position = 0.5
gst.Color.RGB = RGB(0, 255, 0)
gst.Color.Brightness = 0.25
gst.Color.TintAndShade = 0.25
Set gst = ff.GradientStops(3)
gst.Transparency = 0
gst.Position = 1
gst.Color.RGB = RGB(0, 0, 255)
gst.Color.Brightness = 0.25
gst.Color.TintAndShade = 0.25
Set gst = Nothing
Set cht = Nothing
Set ff = Nothing
Set ser = Nothing
Set rng = Nothing
Set sht = Nothing
Set wrk = Nothing
End Sub
Re: [RESOLVED] Excel - VBA - Gradient fills (on graphs)
On the point of a new chart picking up a data series from somewhere where you have not coded any - VB.NET and I'm guessing VBA as well will use the data from the last selected worksheet for any chart sheet that you add. To get round this I now add a blank worksheet just before I add a chart and this stops this happening
