Add a counter to a Power Point Presentation [closed] - vba

Question

Closed. This question is off-topic. It is not currently accepting answers.
Want to improve this question? Update the question so it's on-topic for Stack Overflow.
Closed 9 years ago.
Improve this question
I would like to add a counter to a power point presentation. Someone mentioned to me that this might be doable in VBA. Do you know if this could be done in VBA and how?
Basically here is what I would like to do:
display a counter representing for example the number of cars rented since the beginning of my presentation. So for example, at the start the counter is at 0 and every minute is incremented of 2000 (this is just an example). We can see the counter on every slide, so at the end of my talk people can see (and I'll tell them) that since the beginning of the talk X(large number) cars have been rented.
I tried to find something on the internet but without success... I hope someone will be able to help me?

Answer 1

I give you some ideas. Possibly they will be helpful even I do not provide any code.
Generally you need to have something like 'timer' in your presentation which would start with your presentation and count the time used. Unfortunately there is nothing like this in PowerPoint. You could possibly use some external solution like C# COM add-in but it's rather very complicated.
You could use PP application events but value of the car will not change every minute but every new slide you enter or any other event fires (like moving reverse, etc). It's a bit complicated but within our (StackOverflow users) knowledge.
You could possible search or ask under that link where I used to find lot's of interesting ideas.
I promised to provide solution therefore I'd like to do it even the question is closed. Therefore I do it by re-edition of that answer which I hope is allowed.
We have to be sure that there is a 'text box' where 'count value' would be placed on each slide. Add the following code into Module1 and run it.
Sub Add_CarValue_Text()
Dim SLD As Slide, SHP As Shape, shCarValue As Shape
Dim boCarValue As Boolean
For Each SLD In ActivePresentation.Slides
For Each SHP In SLD.Shapes
If SHP.Name = "CarValue" Then
boCarValue = True
Exit For
End If
Next
If Not boCarValue Then
Set shCarValue = SLD.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 150, 50)
With shCarValue
.Name = "CarValue"
.TextFrame.TextRange.Text = "Cars counter: "
End With
End If
boCarValue = False
Next
End Sub
Add new Class Module and place below code there. Change if necessary.
Public WithEvents PPApp As Application
Private TimerStart As Long
Private Const increasePerMinute = 1000
Private Sub PPApp_SlideShowBegin(ByVal Wn As SlideShowWindow)
TimerStart = Int(Timer)
End Sub
Private Sub PPApp_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
If Not Wn.View.Slide.Shapes("CarValue") Is Nothing Then
Dim Lap As Integer
Lap = (Int(Timer) - TimerStart) / 10 'change for 60 to change from 10sec to 1 min
Wn.View.Slide.Shapes("CarValue").TextFrame.TextRange = "Cars volume: " & Lap * increasePerMinute
End If
End Sub
Add the following code to Module2 and run the procedure.
Public tmpPPApp As New AppClass
Sub StartUp()
Set tmpPPApp.PPApp = PowerPoint.Application
End Sub
Start your presentation.
Important! If you change anything in code please run step 3 again. Moreover, just in case, you need to run procedure 3 always before you lunch the presentation.