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 @

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()

End Sub

Private Sub CheckBox2_Click()
End Sub

Private Sub CheckBox3_Click()
End Sub

Private Sub CheckBox4_Click()
End Sub

Private Sub CheckBox5_Click()
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

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
prefixX = prefixX & "," & xValue
xValue = ""
End If

End If
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, ",,", ",")
allRemoved = True
End If

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
End Sub



No comments: