VBA Change Font Size in a shape

[dareeldill]

I am using Power Point 2010 and Power Point 2013.
I am working on a 30 question test. I have all my coding done until the end of the test but I'm having issues with the code at the end. My intention is to have a button on the last slide that runs macro "PrintablePage" that creates a Results Page.
My two issues are as follows:
1) When I press the button running the "PrintablePage" macro it doesn't take me to the next page that is created. Although when I exit the slideshow I can see that a page was created with all of my results.
2) The page that is created is based off of marcovitz' code, but adjusted to show 30 answers instead of just 3. I need to find a way to adjust the size of the size of the font of the answers section so that it fits on the one slide.
I have noticed several codes in existence to change fonts that I have attempted to add to my line of code but the result usually creates an error. If anyone can help me with where I need to add the code, I would be very greatful.


Sub PrintablePage()
Dim printableSlide As Slide
Dim homeButton As Shape
Dim printButton As Shape

Set printableSlide = _
ActivePresentation.Slides.Add(Index:=printableSlideNum, _
Layout:=ppLayoutText)
printableSlide.Shapes(1).TextFrame.TextRange.Text = _
"Results for " & userName
printableSlide.Shapes(2).TextFrame.TextRange.Text = _
"Your Answers" & Chr$(13) & _
"Question 1: " & answer01 & " Question 2: " & answer02 & " Question 3: " & answer03 & Chr$(13) & _
"Question 4: " & answer04 & " Question 5: " & answer05 & " Question 6: " & answer06 & Chr$(13) & _
"Question 7: " & answer07 & " Question 8: " & answer08 & " Question 9: " & answer09 & Chr$(13) & _
"Question 10: " & answer10 & " Question 11: " & answer11 & " Question 12: " & answer12 & Chr$(13) & _
"Question 13: " & answer13 & " Question 14: " & answer14 & " Question 15: " & answer15 & Chr$(13) & _
"Question 16: " & answer16 & " Question 17: " & answer17 & " Question 18: " & answer18 & Chr$(13) & _
"Question 19: " & answer19 & " Question 20: " & answer20 & " Question 21: " & answer21 & Chr$(13) & _
"Question 22: " & answer22 & " Question 23: " & answer23 & " Question 24: " & answer24 & Chr$(13) & _
"Question 25: " & answer25 & " Question 26: " & answer26 & " Question 27: " & answer27 & Chr$(13) & _
"Question 28: " & answer28 & " Question 29: " & answer29 & " Question 30: " & answer30 & Chr$(13) & _
"You got " & numCorrect & " out of " & _
numCorrect + numIncorrect & "." & Chr$(13) & _
"Press the Print Results button to print your answers."
Shp.Shapes(2).TextRange.Font.Size = 8
Set homeButton = _
ActivePresentation.Slides(printableSlideNum).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(printableSlideNum).Shapes.AddShape _
(msoShapeActionButtonCustom, 200, 0, 150, 50)
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 PrintResults()
ActivePresentation.PrintOptions.OutputType = ppPrintOutputSlides
ActivePresentation.PrintOut From:=printableSlideNum, _
To:=printableSlideNum
End Sub

Sub StartAgain()
ActivePresentation.SlideShowWindow.View.GotoSlide 1
ActivePresentation.Slides(printableSlideNum).Delete
ActivePresentation.Saved = True
End Sub

[John Wilson]

Probably (we need all of the code really)

This:
Shp.Shapes(2).TextRange.Font.Size = 8
Should be:
printableSlide.Shapes(2).TextFrame.TextRange.Font.Size = 8

[dareeldill]

John, You are my personal hero. This worded like a charm. Thank you much.

[John Wilson]

You might also find that your print out routine remembers old ranges. While this usually is OK it can cause problems best to clear them


Sub PrintResults()
With ActivePresentation.PrintOptions
.Ranges.ClearAll
.RangeType = ppPrintSlideRange
.Ranges.Add Start:=printableslidenum, End:=printableslidenum
.OutputType = ppPrintOutputSlides
End With
ActivePresentation.PrintOut
End Sub

Can I suggest you revisit the OTHER forum(s) where you posted this (and people are still working on it) and let them know you have at least a part answer.