A long time ago (nearly 5 years!) I posted this macro that makes a pie for
each row in the data range. The data is in A:E, with the category labels in
A1:E1 and the values in each row below that. The charts are overlapped ot
the right of the data.
Sub LotsaPies()
' Macro recorded and adjusted 2/23/01 by Jon Peltier
Dim obChart As ChartObject
Dim myrow As Long
Dim myrows As Long
' How many pies to make
myrows = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
For myrow = 2 To myrows + 1
' Make a pie with the top left corner in column F
' in same row as data, as wide as columns F through K,
' 17 rows high
' Adjust to suit your tastes
Set obChart = ActiveSheet.ChartObjects.Add(Left:=[F:F].Left, _
Top:=[F1].Offset(myrow - 1, 0).Top, _
Width:=[F:K].Width, Height:=[2:18].Height)
With obChart.Chart
.ChartType = xlPie
' A1:E1 has legend entries
' A(myrow):E(myrow) has data
.SetSourceData PlotBy:=xlRows, Source:= _
ActiveSheet.Range("A1:E1,A" & myrow & ":E" & myrow)
.ApplyDataLabels Type:=xlDataLabelsShowValue, _
LegendKey:=False, HasLeaderLines:=True
.HasTitle = True
With .ChartTitle
.Font.Bold = True
.AutoScaleFont = False
.Left = 88
.Top = 1
End With
With .PlotArea
.Border.LineStyle = xlNone
With .Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
.Height = 50
.Left = 22
.Top = 40
.Width = 156
.Height = 156
End With
' For some reason, I have to activate the chart
' to fix the fonts (otherwise they're all size 2)
.Parent.Activate
With .ChartArea
.Font.Size = 10
.AutoScaleFont = False
End With
End With
' Now deactivate the chart
ActiveWindow.Visible = False
Windows(ActiveWorkbook.Name).Activate
ActiveCell.Activate
Next
End Sub
- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______
