powerpoint random slide display required 2

[petermeachem]

My daughter's teacher would like to show powerpoint slides in a random order (for maths questions etc so the children can't learn the route and have to actually think!).
I'm ok at vb6 but have never used powerpoint at all, so voluntered!
I had a quick look and found gotoslide, which looks hopeful, but I can't see how to call a macro in the first place.
Could some kind soul point me in thr right direction please.

http://www.therockalltimes.co.uk/

http://english2american.com/

 

[fneily]

I'm going to send you two Powerpoint presentations - one uses math and the other is a quiz - plus a word doc containing the code I used. I'll send it to both your email addresses.

Neil

 

[fneily]

I was hoping I could find an email address in one of your URL's. I was wrong

Doing Interactive Math in a PowerPoint Show

Let's say we want to calculate the area of a rectangle.Open a blank slide. Click on View, then Toolbars, then Control Toolbox to bring up the Toolbox. Click on the Text Box control and draw a box on the slide. Create two more Text boxes next to the first. Right click on the first box and choose Properties. Set the following - EnterKeyBehavior to True, Multiline to True, WordWrap to True and Font to your desire. Also give the box a name such as Length. Close the Property Sheet. Repeat for the other two boxes naming them Width and Answer.
From the Control Toolbox, click on the Command Button control and create a button below the three boxes. Create another next to it.
Right click on the first Command Button and choose Properties. Click on the Caption box and name it Calculate. Name the other Clear.
Right click the first Command Button and click View Code. Type the following:
Dim L as single
Dim W as single
Dim A as single
L = Length
W = Width
A = L*W
Answer = A

Right click the other Command Button and click View Code. Type the following:
Length = " "
Width = " "
Answer = " "

Try the boxes in Slide Show.

To Create A PowerPoint Quiz:

First slide as your Intro and a command button on the bottom.
Second slide has four text boxes.
Third slide has one text box and a command button.
Slides four and five are optional. I placed them there so they can see the correct answers.

In PowerPoint, do ALT+F11 to open the VBA window. Click on Insert then Module to create a new module and copy and paste the following code:

In the GENERAL - DECLARATIONS area type:

Const NOOFQS = 3
Const UD_CODE_1 = 111
Const UD_CODE_2 = 8226

Public QNo As Integer
Public Exitflag As Boolean
Public Qs() As String
Public Choices() As String
Public Ans() As Integer
Public counter As Integer
Public UserAns() As Integer

Sub BeginQuiz()
'
' Macro created 4/26/02
'
Dim ctr As Integer
ReDim Qs(NOOFQS)
ReDim Ans(NOOFQS)
ReDim UserAns(NOOFQS)
ReDim Choices(NOOFQS, 3)

Qs(0) = "1) What does Narcissistic mean?"
Qs(1) = "2) What does Confidant mean?"
Qs(2) = "3) Black Pearl is a nick name for?"

For ctr = 0 To NOOFQS - 1
UserAns(ctr) = 0
Next ctr

Choices(0, 0) = "Very Sleepy"
Choices(0, 1) = "Indecisive"
Choices(0, 2) = "Very Vain"

Choices(1, 0) = "Excessive pride"
Choices(1, 1) = "Trusted friend"
Choices(1, 2) = "Secret"

Choices(2, 0) = "Pele"
Choices(2, 1) = "Mohammed Ali"
Choices(2, 2) = "George Foreman"

Ans(0) = 3
Ans(1) = 2
Ans(2) = 1

QNo = 1
counter = 1

Call AssignValues

With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides(2).SlideIndex)
End With
End Sub
Sub AssignValues()
SetBulletUnicode 2, UD_CODE_1
SetBulletUnicode 3, UD_CODE_1
SetBulletUnicode 4, UD_CODE_1

Select Case UserAns(QNo - 1)
Case 1
SetBulletUnicode 2, UD_CODE_2
Case 2
SetBulletUnicode 3, UD_CODE_2
Case 3
SetBulletUnicode 4, UD_CODE_2
End Select

With SlideShowWindows(1).Presentation.Slides(2)
.Shapes(1).TextFrame.TextRange.Text = Qs(QNo - 1)
.Shapes(2).TextFrame.TextRange.Text = Choices(QNo - 1, 0)
.Shapes(3).TextFrame.TextRange.Text = Choices(QNo - 1, 1)
.Shapes(4).TextFrame.TextRange.Text = Choices(QNo - 1, 2)
End With
End Sub
Sub SetBulletUnicode(ShapeName As Integer, Code As Integer)
With SlideShowWindows(1).Presentation.Slides(2) _
.Shapes(ShapeName).TextFrame.TextRange.ParagraphFormat.Bullet
.UseTextFont = msoTrue
.Character = Code
End With
End Sub
Sub ButtonChoice1()
UserAns(QNo - 1) = 1
AssignValues
End Sub
Sub ButtonChoice2()
UserAns(QNo - 1) = 2
AssignValues
End Sub
Sub ButtonChoice3()
UserAns(QNo - 1) = 3
AssignValues
End Sub
Sub NextSlide()
If QNo < NOOFQS Then
QNo = QNo + 1
SlideShowWindows(1).Presentation.Slides(2).Shapes(1) _
.TextFrame.TextRange.Text = Qs(QNo - 1)
AssignValues
Else
Call StopQuiz
End If

DoEvents

End Sub
Sub PreviousSlide()
Static X As Integer
If QNo > 1 Then
QNo = QNo - 1
AssignValues
End If
End Sub

Sub NextAns()
If (counter) = NOOFQS Then
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides(5).SlideIndex)
Exit Sub
End With
End If
With SlideShowWindows(1).Presentation.Slides(4)
.Shapes(1).TextFrame.TextRange.Text = Qs(counter)
.Shapes(2).TextFrame.TextRange.Text = Choices(counter, Ans(counter) - 1)
End With
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides(4).SlideIndex)
End With
counter = counter + 1

End Sub
Sub StopQuiz(Optional EndType As Boolean = False)
Dim ScoreCard As Integer
Dim ctr As Integer
Exitflag = True
With SlideShowWindows(1)
For ctr = 0 To NOOFQS - 1
If Ans(ctr) = UserAns(ctr) Then ScoreCard = ScoreCard + 1
Next ctr
If EndType = False Then
.Presentation.Slides(3).Shapes(1) _
.TextFrame.TextRange.Text = &quot;Your Score is: &quot; _
& ScoreCard & &quot; correct out of &quot; & NOOFQS
Else
.Presentation.Slides(3).Shapes(1) _
.TextFrame.TextRange.Text = &quot;Sorry! You Chickened &quot; _
& &quot;out!&quot; & vbCrLf & &quot;Your Score is: &quot; & ScoreCard & _
&quot; correct out of &quot; & NOOFQS
End If
.View.GotoSlide (.Presentation.Slides(3).SlideIndex)
End With
End Sub

Slide One will then have a command button that calls BeginQuiz().

If you want me to email you any of these powerpoint presentations, and I have one that &quot;hops&quot; around slides, email me at fneily@hotmail.com

Neil

 

[petermeachem]

You are an absolute hero. Thanks so much. I'm pretty sure I can figure it out now, if not I shall be in touch.

http://www.therockalltimes.co.uk/

http://english2american.com/

 

[fneily]

A warning about VBA in PowerPoint - there's this thing called a ZOrder. When you create an object such as a text box, it gets a &quot;number&quot;, sorta like its' on its' own layer. So on slide two, make sure the title text box is created first then the next three text boxes in order. In the code they are referred to as Shape(1), Shape(2), etc.
Oh yeah, all the slides are Blank slides.

Glad to be of help.

 

[onedtent]

written by Brian Reilly, PowerPoint MVP

Sub sort_rand()
Dim i As Integer
Dim myvalue As Integer
Dim islides As Integer
islides = ActivePresentation.Slides.Count
For i = 1 To ActivePresentation.Slides.Count
myvalue = Int((i * Rnd) + 1)
ActiveWindow.ViewType = ppViewSlideSorter
ActivePresentation.Slides(myvalue).Select
ActiveWindow.Selection.Cut
ActivePresentation.Slides(islides - 1).Select
ActiveWindow.View.Paste
Next
End Sub

 

[petermeachem]

And that has filled in a few more gaps. Thanks.

http://www.therockalltimes.co.uk/

http://english2american.com/

 

[petermeachem]

I have ended up with this code. The first slide is the intro, all the others have a button that calls the sub below.
Seems to work ok, don't know if I'm missing something obvious.

Global nQuestions As Long
Global nShown() As Long

Sub RunQuiz()

Dim J As Long

If SlideShowWindows(1).View.Slide.SlideNumber = 1 Then

nQuestions = ActivePresentation.Slides.Count - 1

ReDim nShown(nQuestions)

End If

For J = 1 To nQuestions - 1
If Not nShown(J) Then
GoTo Continue
End If
Next J
MsgBox (&quot;Finished&quot
SlideShowWindows(1).View.GotoSlide 1

Exit Sub

Continue:

Do
J = Int((nQuestions) * Rnd + 1)
If Not nShown(J) Then
Exit Do
End If
Loop

nShown(J) = True

SlideShowWindows(1).View.GotoSlide J + 1

End Sub

http://www.therockalltimes.co.uk/

http://english2american.com/