|
-
Apr 17th, 2014, 01:50 PM
#1
Thread Starter
Don't Panic!
[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
Feeling like a fly on the inside of a closed window (Thunk!)
If I post a lot, it is because I am bored at work! ;D Or stuck...
* Anything I post can be only my opinion. Advice etc is up to you to persue...
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|