Hi guys,
I have tried to run the code given to draw smooth transparent shapes on radar chart, as suggested by Peltier as shown in the website below.
http://peltiertech.com/Excel/Charts/VBAdrawradar.html#SmoothTransShape
I believe some of you should be an expert in handling the chartin Excel, therefore your help will be greatly appreciated!
It seems there is some customization needed in order for this code to run smoothly at any excel file. You guys can help me to highlight anything that I might miss out on the code written.
Once again, thank you for your great assistance and help, guys! Looking forward to hearing back a good news from you guys soon!
Warmest Regards,
Willy
---
Sub DrawTransparentShapesOnRadarChart()
Dim cht As Chart
Dim srs As Series
Dim iSrs As Long
Dim Npts As Integer
Dim Ipts As Integer
Dim myShape As Shape
Dim Xnode As Double, Ynode As Double
Dim Rmax As Double, Rmin As Double
Dim Xleft As Double, Ytop As Double
Dim Xwidth As Double, Yheight As Double
Dim dPI As Double
Dim iFillColor As Long
Dim iLineColor As Long
'Dim Pict As Object
'Dim xlApp As Excel.Application
'Dim xlWB As Workbook
'Set xlApp = New Excel.Application
'Set xlWB = xlApp.Workbooks.Open(excelfile)
'Sheets("CMP Tool Capacity Model").Select
'Set Pict = ActiveSheet.ChartObjects("Chart 2")
Set cht = ActiveChart
Xleft = cht.PlotArea.InsideLeft
Xwidth = cht.PlotArea.InsideWidth
Ytop = cht.PlotArea.InsideTop
Yheight = cht.PlotArea.InsideHeight
Rmax = cht.Axes(2).MaximumScale
Rmin = cht.Axes(2).MinimumScale
dPI = WorksheetFunction.Pi()
For iSrs = 1 To cht.SeriesCollection.Count
Set srs = cht.SeriesCollection(iSrs)
Select Case srs.ChartType
Case xlRadar, xlRadarFilled, xlRadarMarkers
Npts = srs.Points.Count
Xnode = Xleft + Xwidth / 2 * (1 + (srs.Values(Npts) - Rmin) / (Rmax - Rmin) * Sin(2 * dPI * (Npts - 1) / Npts))
Ynode = Ytop + Yheight / 2 * (1 - (srs.Values(Npts) - Rmin) / (Rmax - Rmin) * Cos(2 * dPI * (Npts - 1) / Npts))
With cht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
For Ipts = 1 To Npts
Xnode = Xleft + Xwidth / 2 * (1 + (srs.Values(Ipts) - Rmin) / (Rmax - Rmin) * Sin(2 * dPI * (Ipts - 1) / Npts))
Ynode = Ytop + Yheight / 2 * (1 - (srs.Values(Ipts) - Rmin) / (Rmax - Rmin) * Cos(2 * dPI * (Ipts - 1) / Npts))
.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Next
Set myShape = .ConvertToShape
End With
For Ipts = 1 To Npts
myShape.Nodes.SetEditingType 3 * Ipts - 2, msoEditingSmooth
Next
Select Case iSrs
Case 1
iFillColor = 44
iLineColor = 12
Case 2
iFillColor = 45
iLineColor = 10
Case 3
iFillColor = 43
iLineColor = 17
End Select
With myShape
.Fill.ForeColor.SchemeColor = iFillColor
.Line.ForeColor.SchemeColor = iLineColor
.Line.Weight = 1.5
.Fill.Transparency = 0.5
End With
End Select
Next
End Sub
I have tried to run the code given to draw smooth transparent shapes on radar chart, as suggested by Peltier as shown in the website below.
http://peltiertech.com/Excel/Charts/VBAdrawradar.html#SmoothTransShape
I believe some of you should be an expert in handling the chartin Excel, therefore your help will be greatly appreciated!
It seems there is some customization needed in order for this code to run smoothly at any excel file. You guys can help me to highlight anything that I might miss out on the code written.
Once again, thank you for your great assistance and help, guys! Looking forward to hearing back a good news from you guys soon!
Warmest Regards,
Willy
---
Sub DrawTransparentShapesOnRadarChart()
Dim cht As Chart
Dim srs As Series
Dim iSrs As Long
Dim Npts As Integer
Dim Ipts As Integer
Dim myShape As Shape
Dim Xnode As Double, Ynode As Double
Dim Rmax As Double, Rmin As Double
Dim Xleft As Double, Ytop As Double
Dim Xwidth As Double, Yheight As Double
Dim dPI As Double
Dim iFillColor As Long
Dim iLineColor As Long
'Dim Pict As Object
'Dim xlApp As Excel.Application
'Dim xlWB As Workbook
'Set xlApp = New Excel.Application
'Set xlWB = xlApp.Workbooks.Open(excelfile)
'Sheets("CMP Tool Capacity Model").Select
'Set Pict = ActiveSheet.ChartObjects("Chart 2")
Set cht = ActiveChart
Xleft = cht.PlotArea.InsideLeft
Xwidth = cht.PlotArea.InsideWidth
Ytop = cht.PlotArea.InsideTop
Yheight = cht.PlotArea.InsideHeight
Rmax = cht.Axes(2).MaximumScale
Rmin = cht.Axes(2).MinimumScale
dPI = WorksheetFunction.Pi()
For iSrs = 1 To cht.SeriesCollection.Count
Set srs = cht.SeriesCollection(iSrs)
Select Case srs.ChartType
Case xlRadar, xlRadarFilled, xlRadarMarkers
Npts = srs.Points.Count
Xnode = Xleft + Xwidth / 2 * (1 + (srs.Values(Npts) - Rmin) / (Rmax - Rmin) * Sin(2 * dPI * (Npts - 1) / Npts))
Ynode = Ytop + Yheight / 2 * (1 - (srs.Values(Npts) - Rmin) / (Rmax - Rmin) * Cos(2 * dPI * (Npts - 1) / Npts))
With cht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
For Ipts = 1 To Npts
Xnode = Xleft + Xwidth / 2 * (1 + (srs.Values(Ipts) - Rmin) / (Rmax - Rmin) * Sin(2 * dPI * (Ipts - 1) / Npts))
Ynode = Ytop + Yheight / 2 * (1 - (srs.Values(Ipts) - Rmin) / (Rmax - Rmin) * Cos(2 * dPI * (Ipts - 1) / Npts))
.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Next
Set myShape = .ConvertToShape
End With
For Ipts = 1 To Npts
myShape.Nodes.SetEditingType 3 * Ipts - 2, msoEditingSmooth
Next
Select Case iSrs
Case 1
iFillColor = 44
iLineColor = 12
Case 2
iFillColor = 45
iLineColor = 10
Case 3
iFillColor = 43
iLineColor = 17
End Select
With myShape
.Fill.ForeColor.SchemeColor = iFillColor
.Line.ForeColor.SchemeColor = iLineColor
.Line.Weight = 1.5
.Fill.Transparency = 0.5
End With
End Select
Next
End Sub
