PowerPoint Quiz - VBA to print result

After this:

.TextFrame.TextRange.Text = (userName & " got " & percent & " % correct")

add this:

.Name = "Score"

Then after this:

ActivePresentation.PrintOut From:=21, To:=21

Add:

ActivePresentation.Slides(21).Shapes("Score").Delete

Things are getting very close now toa  working VBA interactive quiz that  I want.

The problem now is when I initialise back to the start for the next peson, the text box on the last slide is over written by the next person's score I need to delete/reset this text box on start,

Public NumberCorrect As Integer

Dim userName As String

'Public variables retain their value so they can be added to each time a macro is run.

Sub Initialise()

'Sets the score to zero so it’s not added to the previous user’s total, and goes to the first question.

NumberCorrect = 0

With SlideShowWindows(1).View

    .GotoSlide 1

End With

End Sub

Sub Correct()

'Adds one to the total correct and moves to the next slide

NumberCorrect = NumberCorrect + 1

End Sub

Sub Wrong()

'Takes away one to the total correct and moves to the next slide

NumberCorrect = NumberCorrect - 1

End Sub

Sub Display()

'Shows the result in a pop-up message box with some explanatory text

percent = ((NumberCorrect * 4.347826) * 1)

percent = Round(percent, 0)

MsgBox (userName & " got " & percent & " % correct")

ActivePresentation.SlideShowWindow.View.Next

End Sub

Sub YourName()

    Dim done As Boolean

        done = False

        ActivePresentation.SlideShowWindow.View.Next

    While Not done

        userName = InputBox(prompt:="Type your name", _

            Title:="Input Name")

        If userName = "" Then

            done = False

        Else

            done = True

        End If

    Wend

ActivePresentation.SlideShowWindow.View.Next

End Sub

      Sub PutTextOnSlideExample()

' This will add text to slide 1

' Change to whatever slide you need the text on

' Change the Left, Top, Width, Height (in that order) as needed

 percent = ((NumberCorrect * 4.347826) * 1)

 percent = Round(percent, 0)

 With ActivePresentation.Slides(21)

 With .Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 500, 100)

      .TextFrame.TextRange.Text = (userName & " got " & percent & " % correct")

 End With

 End With

PrintLastSlide

End Sub

    Sub PrintLastSlide()

ActivePresentation.PrintOptions.OutputType = ppPrintOutputSlides

ActivePresentation.PrintOut From:=21, To:=21

ActivePresentation.SlideShowWindow.View.Exit

  End Sub

Here's something to start with; modify at will:

Sub PutTextOnSlideExample()

' This will add text to slide 1

' Change to whatever slide you need the text on

' Change the Left, Top, Width, Height (in that order) as needed

With ActivePresentation.Slides(1)

With .Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 500, 100)

.TextFrame.TextRange.Text = "Here is your new text"

End With

End With

End Sub

Thanks for the heads up about msgBox.

Got any examples of VBA code to to this.  I am not too good at writing VBA but have modified bits of code.

MsgBoxes will not print. You need to modify your code to add the results to a slide not display as a message box.