PowerPoint & VBA = Free Fishing Trip!
I am working on an interactive PowerPoint presentation that includes a mulitple choice test at the end. I have vba setup to create and print a slide. The sub "What's my Grade" tallies up the number answered right and wrong correctly and vba creates the slide. The problem is twofold: 1) the slide will not print, and 2) the slide is blank. It just says "results for___" and nothing. I have beat my head on the wall all week with this, even comparing other presentations I have done that work the same way. No luck. Any assistance will be appreciated. Free fishing trip in Nashville for anyone that can help!
[VBA]Dim numcorrect As Integer
Dim numincorrect As Integer
Dim username As String
Dim q30answered As Boolean
Dim q31answered As Boolean
Dim q32answered As Boolean
Dim q33answered As Boolean
Dim q34answered As Boolean
Dim q35answered As Boolean
Dim q36answered As Boolean
Dim q37answered As Boolean
Dim q38answered As Boolean
Dim q39answered As Boolean
Dim answer30 As String
Dim answer31 As String
Dim answer32 As String
Dim answer33 As String
Dim answer34 As String
Dim answer35 As String
Dim answer36 As String
Dim answer37 As String
Dim answer38 As String
Dim answer39 As String
Dim printableslidenumber As Long
Sub getstarted()
initialize
yourname
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub initialize()
numcorrect = 0
numincorrect = 0
q30answered = False
q31answered = False
q32answered = False
q33answered = False
q34answered = False
q35answered = False
q36answered = False
q37answered = False
q38answered = False
q39answered = False
printableslidenumber = ActivePresentation.Slides.Count + 1
End Sub
Sub yourname()
username = InputBox(Prompt:="Please tell me your first and last name")
MsgBox ("Thank You, " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub doingpoorly()
MsgBox ("Sorry, that is the wrong answer, " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer30deathorinjury()
If q30answered = False Then
numcorrect = numcorrect + 1
answer30 = "Death or Injury" 'Added
End If
q30answered = True
MsgBox ("Fabulous job! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer30overtime()
If q30answered = False Then
numincorrect = numincorrect + 1
answer30 = "overtime" 'added
End If
q30answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer30carelessness()
If q30answered = False Then
numincorrect = numincorrect + 1
answer30 = "Carelessness"
End If
q30answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer31byprovidingaphysicalbarrierbetweenusandthemovingmachineparts()
If q31answered = False Then
numcorrect = numcorrect + 1
answer31 = "By providing a physical barrier between us and the moving machine parts"
End If
q31answered = True
MsgBox ("Great job! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer31byprovidinguswithstepbystepinstructionsonsonhowtosafelyoperatetheeq uipment()
If q31answered = False Then
numincorrect = numincorrect + 1
answer31 = "By providing us with step by step instructions on how to safely operate the equipment"
End If
q31answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer31byprovidinguswithareportingprocedureforunsafeprocedures()
If q31answered = False Then
numincorrect = numincorrect + 1
answer31 = "By providing us with a reporting procedure for unsafe procedures"
End If
q31answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer32alloftheabove()
If q32answered = False Then
numcorrect = numcorrect + 1
answer32 = "All of the above"
End If
q32answered = True
MsgBox ("Wonderfully done! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer32distancetripguards()
If q32answered = False Then
numincorrect = numincorrect + 1
answer32 = "Distance & trip guards"
End If
q32answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer32automaticlockingguards()
If q32answered = False Then
numincorrect = numincorrect + 1
answer32 = "Automatic & Locking Guards"
End If
q32answered = True
doingpoorly
End Sub
Sub answer33safetyshoeshearingprotectionsafetyglasses()
If q33answered = False Then
numcorrect = numcorrect + 1
answer33 = "Safety Shoes, Hearing Protection, Safety Glasses"
End If
q33answered = True
MsgBox ("Fantastic! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer33safetyshoessafetyglovesworkboots()
If q33answered = False Then
numincorrect = numincorrect + 1
answer33 = "Safety Shoes, Safety Gloves, Work Boots"
End If
q33answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer33hearingprotectionsafetybootssafetyglasses()
If q33answered = False Then
numincorrect = numincorrect + 1
answer33 = "Hearing protection, Safety boots, Safety glasses"
End If
q33answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer34true()
If q34answered = False Then
numcorrect = numcorrect + 1
answer34 = "True"
End If
q34answered = True
MsgBox ("Excellent choice! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer34false()
If q34answered = False Then
numincorrect = numincorrect + 1
answer34 = "False"
End If
q34answered = True
ActivePresentation.SlideShowWindow.View.Next
doingpoorly
End Sub
Sub answer354()
If q35answered = False Then
numcorrect = numcorrect + 1
answer35 = "4"
End If
q35answered = True
MsgBox ("Brilliant! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer352()
If q35answered = False Then
numincorrect = numincorrect + 1
answer35 = "2"
End If
q35answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer356()
If q35answered = False Then
numincorrect = numincorrect + 1
answer35 = "6"
End If
q35answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer358()
If q35answered = False Then
numincorrect = numincorrect + 1
answer35 = "8"
End If
q35answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer36onequarterinchheightsetting()
If q36answered = False Then
numcorrect = numcorrect + 1
answer36 = "One quarter inch height setting"
End If
q36answered = True
MsgBox ("Very nice! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer36theextracarefulsetting()
If q36answered = False Then
numincorrect = numincorrect + 1
answer36 = "The extra careful setting"
End If
q36answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer36thedangerclosesetting()
If q36answered = False Then
numincorrect = numincorrect + 1
answer36 = "The danger close setting"
End If
q36answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer378()
If q37answered = False Then
numcorrect = numcorrect + 1
answer37 = "8"
End If
q37answered = True
MsgBox ("Great work! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer3711()
If q37answered = False Then
numincorrect = numincorrect + 1
answer37 = "11"
End If
q37answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer376()
If q37answered = False Then
numincorrect = numincorrect + 1
answer37 = "6"
End If
q37answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer374()
If q37answered = False Then
numincorrect = numincorrect + 1
answer37 = "4"
End If
q37answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer38safetyinterlocks()
If q38answered = False Then
numcorrect = numcorrect + 1
answer38 = "Safety Interlocks"
End If
q38answered = True
MsgBox ("You are doing beautifully! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer38dangercloseswitches()
If q38answered = False Then
numincorrect = numincorrect + 1
answer38 = "Danger close switches"
End If
q38answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer39true()
If q39answered = False Then
numcorrect = numcorrect + 1
answer39 = "True"
End If
q39answered = True
MsgBox ("Awesome! , " & username)
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub answer39false()
If q39answered = False Then
numincorrect = numincorrect + 1
answer39 = "False"
End If
q39answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer30()
If q30answered = False Then
numincorrect = numincorrect + 1
End If
q30answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer31()
If q31answered = False Then
numincorrect = numincorrect + 1
End If
q31answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer32()
If q32answered = False Then
numincorrect = numincorrect + 1
End If
q32answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer33()
If q33answered = False Then
numincorrect = numincorrect + 1
End If
q33answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer34()
If q34answered = False Then
numincorrect = numincorrect + 1
End If
q34answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer35()
If q35answered = False Then
numincorrect = numincorrect + 1
End If
q35answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer36()
If q36answered = False Then
numincorrect = numincorrect + 1
End If
q36answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer37()
If q37answered = False Then
numincorrect = numincorrect + 1
End If
q37answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer38()
If q38answered = False Then
numincorrect = numincorrect + 1
End If
q38answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub wronganswer39()
If q39answered = False Then
numincorrect = numincorrect + 1
End If
q39answered = True
doingpoorly
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub printablepage()
Dim printableSlide As Slide
Dim homebutton As Shape
Dim printbutton As Shape
Set printableSlide = _
ActivePresentation.Slides.Add(Index:=42, Layout:=ppLayoutText)
printableSlide.Shapes(1).TextFrame.TextRange.Text = "Results for " & username
printableSlide.Shapes(2).TextFrame.TextRange.Text = "Your answers" & Chr$(13) & _
"Question 30: " & answer30 & Chr$(13) & _
"Question 31: " & answer31 & Chr$(13) & _
"Question 32: " & answer32 & Chr$(13) & _
"Question 33: " & answer33 & Chr$(13) & _
"Question 34: " & answer34 & Chr$(13) & _
"Question 35: " & answer35 & Chr$(13) & _
"Question 36: " & answer36 & Chr$(13) & _
"Question 37: " & answer37 & Chr$(13) & _
"Question 38: " * answer38 & Chr$(13) & _
"Question 39: " & answer39 & Chr$(13) & _
"You got " & numcorrect & " out of " & numcorrect + numincorrect & "." & Chr$(13) & _
"Press the Print Results button to print you answers."
printableSlide.Shapes(2).TextFrame.TextRange.Font.Size = 15
Set homebutton = ActivePresentation.Slides(42).Shapes.AddShape _
(msoShapeActionButtonCustom, 0, 0, 150, 50)
homebutton.TextFrame.TextRange.Text = "Start Again"
homebutton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
homebutton.ActionSettings(ppMouseClick).Run = "StartAgain"
Set printbutton = ActivePresentation.Slides(42).Shapes.AddShape _
(msoShapeActionButtonCustom, 200, 0, 150, 50)
printbutton.TextFrame.TextRange.Text = "printresults"
printbutton.TextFrame.TextRange.Text = "Print Results"
printbutton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
printbutton.ActionSettings(ppMouseClick).Run = "printresults"
ActivePresentation.SlideShowWindow.View.Next
ActivePresentation.Saved = True
End Sub
Sub WhatsMyGrade()
If numincorrect = 0 Then
MsgBox ("You scored 100 % and Reveived an A+, Great Work!")
ElseIf numincorrect = 1 Then
MsgBox ("You scored 90 % and Received an A, Good Job!")
ElseIf numincorrect = 2 Then
MsgBox ("You Scored 80 % and Received a B, Way to GO!")
ElseIf numincorrect = 3 Then
MsgBox ("You Scored 70 & and Received a C, That's Good Enough!")
ElseIf numincorrect = 4 Then
MsgBox ("You Scored 60 % and Received a D, uh-oh what Happened?")
Else: MsgBox ("You got an F, You Can Always Try again!")
End If
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub startagain()
ActivePresentation.SlideShowWindow.View.GotoSlide (1)
ActivePresentation.Slides(42).Delete
ActivePresentation.Saved = True
End Sub
Sub printresults()
ActivePresentation.PrintOptions.OutputType = ppPrintOutputSlides
ActivePresentation.PrintOut from:=42, to:=42
End Sub[/VBA]
Reply With Quote
