<

Generating pseudo-random numbers on Powerpoint slideshow

Published on
20,182 Points
14,082 Views
1 Endorsement
Last Modified:
Approved
Community Pick
This article describes how to make a simple, pseudo-random number generator in Microsoft PowerPoint. The code checks the generated numbers against a list of numbers already generated to prevent duplication. We used this as a youth group activity but it could be adapted for other entertainment or competition purposes as well. This macro demonstrates the power of Visual Basic for Applications (VBA) in PowerPoint to obtain data from, and make dynamic changes to, elements of a slideshow at runtime.

This code generates pseudo-random numbers between 1 and 75. The lower and upper limits can be changed by setting the constants SMALLEST_NUMBER and BIGGEST_NUMBER, respectively, in the declarations area of the code. The macro also stores a list of the generated numbers (PickedNumbers private integer array) and checks to see if a newly generated number has already been selected and used. The generated numbers can be reset by clicking the asterisk button on the slide as the 'game' is running. Once all the possible numbers have been used, the macro disables the button to generate the next number and forces the user to press the reset button to continue.

The textbox is included for authenticity, as it allows the user to change the letter on the 'bingo ball'. Changes in this textbox are reflected on the 'bingo ball'. No letter needs to be entered.

To try this macro out, download the PPTX (for PowerPoint 2007 and up) or PPT and then open up VBA (for example, in PowerPoint 2007, click the Developer tab on the ribbon, then select Visual Basic).
bingo.ppt bingo.pptx

Then open the code for Slide 1, and paste the attached code into the window, if the code is not there already.
Option Explicit

Private PickedNumbers() As Integer

'change these two constants to modify the allowed range of numbers
Private Const SMALLEST_NUMBER As Integer = 1
Private Const BIGGEST_NUMBER As Integer = 75

Private Sub cmdNextNumber_Click()

On Error GoTo ErrHandler

Dim tmpNumber As Integer
Dim a As Integer
Dim textToShow As String

Randomize Timer

If (UBound(PickedNumbers)) > (BIGGEST_NUMBER - SMALLEST_NUMBER) Then
    'end of game, all numbers have been picked already
    'the reset button must be pressed to continue
    textToShow = "--"
    cmdNextNumber.Enabled = False
Else
    If UBound(PickedNumbers) = 0 Then
        'call a function to generate a pseud-random number
        tmpNumber = generateANumber
    Else
        'check if the generated number has already been chosen by looping through the stored number array
        Do
        tmpNumber = generateANumber
            For a = 0 To UBound(PickedNumbers)
                If tmpNumber = PickedNumbers(a) Then Exit For
            DoEvents
            Next a
            If a - 1 = UBound(PickedNumbers) Then Exit Do 'all stored numbers searched, new number is indeed new
        DoEvents
        Loop
    End If
    'store the new number in the array, expand the array for the next number, and update the total numbers display
    PickedNumbers(UBound(PickedNumbers)) = tmpNumber
    textToShow = tmpNumber
    ReDim Preserve PickedNumbers(UBound(PickedNumbers) + 1)
    lblTotalNumberOfNumbers.Caption = UBound(PickedNumbers)
End If

'set the text on the ball
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange.Text = textToShow

Exit Sub
ErrHandler:
Select Case Err.Number
    Case 9
        ReDim PickedNumbers(0)
        Resume
End Select

End Sub

Private Function generateANumber() As Integer

Dim tmpNumber As Integer
Do Until tmpNumber >= SMALLEST_NUMBER And tmpNumber <= BIGGEST_NUMBER
    'generate a pseudo-random number using the Rnd function
    tmpNumber = Round(Rnd * BIGGEST_NUMBER)
DoEvents
Loop
generateANumber = tmpNumber

End Function

Private Sub cmdReset_Click()

Erase PickedNumbers
cmdNextNumber.Enabled = True
lblTotalNumberOfNumbers.Caption = ""
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange.Text = ""

End Sub

Private Sub txtBallLabel_Change()

ActivePresentation.Slides(1).Shapes(3).TextFrame.TextRange.Text = txtBallLabel.Text

End Sub

Open in new window


To 'play', start the slideshow (press F5), click the * button to reset, and start generating numbers by clicking the > button.  
1
Comment
Author:atomsheep
5 Comments
 
LVL 23

Expert Comment

by:JSRWilson
Nice code!

Just a thought when most numbers have "gone" it could take a while to generate a number that is not in the array of picked numbers.

I would maybe
1. generate an array with ALL the numbers
2. Randomly choose a position in the array and read the number stored there.
3. Read the top number in the array and make the chosen position this value
4. Redim 1 to Ubound-1 to strip the old top number

Chose another random number based on the new Ubound

Hope that makes sense.
0
 
LVL 7

Author Comment

by:atomsheep
Good point, JSRWilson. That would form a better user experience, especially on slower machines or when a large range is used. Thanks for the comment.
0
 

Expert Comment

by:joy2love
Is there a way to view or store the previously used random numbers in a separate file or powerpoint slide?
0
 
LVL 23

Expert Comment

by:JSRWilson
Lots of ways but you should ask this as a question in the main area. Include exactly what you aare trying to acheive.
0
 
LVL 47

Expert Comment

by:aikimark
In case anyone is interested in the behavior of the VB PRNG, I've republished my article on the subject here at EE: http:A_11114.html
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Join & Write a Comment

This video teaches viewers how to add transitions to their Slideshows and how to set up timing for the transitions.
The viewer will learn how to edit text. This includes Font, Spacing, Resizing, Color, and other special text options.

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month