AJP Excel InformationAJP Excel Information
ChartsVBAFun stuffForumsTipsLinksBooksWhat's newContactAboutSearchRSS Feed

 
 
 

Size Pie in relation to sum of data

 

The VBA code determines the pie chart with the largest sum of values and then resizes the plot areas of the other pie charts in proportion to the largest ones diameter or area.
The plot areas take there position from the largest pie chart.
 
 
Sub SizePies()
'
' Resize pie charts based on sum of the slice values
' Either in relation to the diameter of the area
'
    Dim chtPies() As Chart
    Dim chtBiggestPie As Chart
    Dim dblTotal() As Double
    Dim lngPieCount As Long
    Dim objTemp As ChartObject
    Dim objWSF As WorksheetFunction
    Dim lngIndex As Long
    Dim dblArea As Double
    
    Set objWSF = Application.WorksheetFunction
    
    For Each objTemp In ActiveSheet.ChartObjects
        Select Case objTemp.Chart.ChartType
        Case xl3DPie, xl3DPieExploded, xlPie, xlPieExploded
            lngPieCount = lngPieCount + 1
            ReDim Preserve dblTotal(lngPieCount) As Double
            ReDim Preserve chtPies(lngPieCount) As Chart
            
            Set chtPies(lngPieCount) = objTemp.Chart
            dblTotal(lngPieCount) = objWSF.Sum(objTemp.Chart.SeriesCollection(1).Values)
            If dblTotal(lngPieCount) > dblTotal(0) Then
                dblTotal(0) = dblTotal(lngPieCount)
                Set chtBiggestPie = chtPies(lngPieCount)
            End If
        End Select
    Next
    
    ' don't bother if only 1 chart or no data
    If lngPieCount <= 1 Then Exit Sub
    If dblTotal(0) = 0 Then Exit Sub
    
    If Range("N4") Then
        ' Size relative to diameter
        For lngIndex = 1 To lngPieCount
            With chtPies(lngIndex)
                .ChartTitle.Text = Format$(dblTotal(lngIndex) _
/ dblTotal(0), "0.0%") & " D" & Format$(dblTotal(lngIndex), "0.0")
                With .PlotArea
                    .Width = chtBiggestPie.PlotArea.Width * (dblTotal(lngIndex) / dblTotal(0))
                    ' center plotarea
                    .Left = chtBiggestPie.PlotArea.Left + _
((chtBiggestPie.PlotArea.Width - .Width) / 2)
                    .Top = chtBiggestPie.PlotArea.Top + _
((chtBiggestPie.PlotArea.Height - .Height) / 2)
                End With
            End With
        Next
    End If
    
    If Range("N6") Then
        ' Size relative to area
        dblArea = objWSF.Pi * ((chtBiggestPie.PlotArea.Width / 2) ^ 2)
        For lngIndex = 1 To lngPieCount
            With chtPies(lngIndex)
                .ChartTitle.Text = Format$(dblTotal(lngIndex) / dblTotal(0), "0.0%") & _
" A" & Format$(dblTotal(lngIndex), "0.0")
                With .PlotArea
                    .Width = (((dblArea * (dblTotal(lngIndex) / dblTotal(0))) / objWSF.Pi) _
^ 0.5) * 2
                    ' center plotarea
                    .Left = chtBiggestPie.PlotArea.Left + _
((chtBiggestPie.PlotArea.Width - .Width) / 2)
                    .Top = chtBiggestPie.PlotArea.Top + _
((chtBiggestPie.PlotArea.Height - .Height) / 2)
                End With
            End With
        Next
    End If
End Sub


 
The download contains the 9 pie charts and option buttons to all sizing according to diameter or area.
 
 
   
 
 
  Home | Charts | VBA Code | Fun Stuff
Forum Examples | Tips | Links | What's New | Book List
Contact | About
Microsoft® and Microsoft® Excel are registered trademarks of the Microsoft Corporation.
andypope.info is not associated with Microsoft. Copyright ©2007-2012 Andy Pope