Thursday, May 14, 2009

Automatic Updating chart

Hi All,

I was reading a forum : Powerpoint Forum where I found a query. And since I have not tried working rigorously with Charts, I thought it will be a worth trying. A guy in the forum asked a question see the question here :

Click me for the Question

Basically he wants to something like following :

He has a Chart in a PowerPoint Slide, and the series will be added/ removed through click of checkbox buttons as given in the following image







And if user unchecks a checkbox, then the series will be removed from the Chart. For example, if I uncheck the 2nd checkbox, the output will be like following:



The 2nd option is deleted.

I did it...though through a tweak, but yes I did it. I am sure that someone may have a better solution and if someone has then please do forward me @ vikasbhandari2@gmail.com

Would like to add again, that since I don't access a file hosting site so I am adding the code here only. Send me a mail if you want a copy of it. :P

Private Sub CheckBox1_Click()
UpdateChart

End Sub

Private Sub CheckBox2_Click()
UpdateChart
End Sub

Private Sub CheckBox3_Click()
UpdateChart
End Sub

Private Sub CheckBox4_Click()
UpdateChart
End Sub

Private Sub CheckBox5_Click()
UpdateChart
End Sub


Sub UpdateChart()
Dim chrt As Chart
Dim chrtShape As Shape
Dim seriesList As seriesCollection
Dim iSeries As Series
Dim chrtWorkbook As Excel.Workbook
Dim seriesSelected(5) As Boolean
Dim wrkbook As Object

seriesSelected(1) = CheckBox1.Value
seriesSelected(2) = CheckBox2.Value
seriesSelected(3) = CheckBox3.Value
seriesSelected(4) = CheckBox4.Value
seriesSelected(5) = CheckBox5.Value



If seriesSelected(1) = False And seriesSelected(2) = False And _
seriesSelected(2) = False And seriesSelected(2) = False And _
seriesSelected(2) = False Then

MsgBox "No checkbox checked. Exiting sub"
Exit Sub
End If


On Error Resume Next
Set chrtShape = ActivePresentation.Slides(1).Shapes("Chart 3")
Set chrt = chrtShape.Chart
chrt.ChartData.Activate
Err.Clear


Dim xValue As String
Dim rowCounter As Integer
Dim addedOnce As Boolean
Dim frstTime As Boolean
Dim brCounter As Integer
Dim prefixY As String
frstTime = True
addedOnce = False

rowCounter = 1
xValue = "$A$1:$A$6"
brCounter = 0
rowCounter = 1
On Error GoTo 0
Set iSeries = chrt.seriesCollection(1)

For i = 1 To 5
rowCounter = rowCounter + 1

If seriesSelected(i) = False Then
brCounter = rowCounter
If addedOnce Then
If frstTime Then
prefixX = xValue
xValue = ""
frstTime = False
Else
prefixX = prefixX & "," & xValue
xValue = ""
End If
Else

End If
Else
addedOnce = True
xValue = "Sheet1!$A$" & brCounter + 1 & ":$B$" & rowCounter
End If

Next i

Dim allRemoved As Boolean

allRemoved = False

While Not allRemoved
If InStr(1, prefixX, ",,") > 0 Then
prefixX = Replace(prefixX, ",,", ",")
Else
allRemoved = True
End If
Wend

prefixX = prefixX & "," & xValue
xValue = Replace(prefixX, ",,", ",")


If Right(xValue, 1) = "," Then
xValue = Mid(xValue, 1, Len(xValue) - 1)
End If

If Left(xValue, 1) = "," Then
xValue = Mid(xValue, 2, Len(xValue) - 1)
End If

chrt.SetSourceData xValue
chrt.ChartData.Workbook.Close
Err.Clear
End Sub


HTH.

Thanks,
Vikas

No comments: