View Single Post
 
Old 10-29-2013, 12:55 AM
jason66 jason66 is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Oct 2013
Posts: 6
jason66 is on a distinguished road
Default A Solution

I managed to find something last night with the help of a friend although where it came from is a bit of a mystery! Kudos to the original author, sorry we can't trace where it came from.

Anyway, here's a simple counter in PowerPoint that runs throughout the presentation (it's in the Master Slide template).

To make the counter total your chosen metric just edit the VBA - for instance I want it to show £76.10 every 60 seconds.

Limitations are that as soon as you click the button it registered one unit (in my case £76.10) and I can't seem to figure out how to show decimals so it rounds the number (and just shows £76)

Here's the code I used

Code:
Dim Offset As Single
Dim CountNo As Long
Dim x As Single


Private Sub CommandButton1_Click()

Offset = ActivePresentation.PageSetup.SlideHeight + 10
CountNo = 76.1
' ADJUST THIS waitTime NUMBER WITH SECONDS DELAY BETWEEN COUNTER INCREMENTS
waitTime = 60
' ADJUST THIS maxCount NUMBER WITH MAXIMUM NUMBER COUNTER SHOULD REACH
maxCount = 500000

Do Until CountNo = maxCount + 76.1
  ActivePresentation.SlideMaster.Shapes("Counter").TextFrame.TextRange.Text = CountNo
  ActivePresentation.SlideMaster.Shapes("Counter").Top = ActivePresentation.SlideMaster.Shapes("Counter").Top + Offset
  DoEvents
  ActivePresentation.SlideMaster.Shapes("Counter").Top = ActivePresentation.SlideMaster.Shapes("Counter").Top - Offset

  x = Timer
  While Timer - x < waitTime
    DoEvents
  Wend

  CountNo = CountNo + 76.1
  
  If SlideShowWindows.Count = 0 Then
    ActivePresentation.SlideMaster.Shapes("Counter").TextFrame.TextRange.Text = 1
    ActivePresentation.SlideMaster.Shapes("Counter").Top = ActivePresentation.SlideMaster.Shapes("Counter").Top + Offset
    DoEvents
    ActivePresentation.SlideMaster.Shapes("Counter").Top = ActivePresentation.SlideMaster.Shapes("Counter").Top - Offset
    Exit Do
  End If
  
Loop

End Sub
Attached Files
File Type: zip Powerpoint with counter.zip (38.8 KB, 191 views)
Reply With Quote