PDA

View Full Version : Newbie Needs Help with Powerpoint code



CBiscuit
03-15-2017, 11:16 PM
Hello VBA World.

I could use some help with the blow code. I have been reading and searching the internet for help and trying to understand the HOW TO code in VBA Powerpoint.

Not sure if I need all the DIM variables or should I list them all at the very beginning.

I just need someone to look over the code below and tell me where I am going wrong or what I did wrong, how to improve it Do I need the Sub Initialise() script.
I ben reading and trying other codes that I thought might work and after modifying them for my needs.

If need be I can send you the Powerpoint file, thanks.

I have just purchased several books to help me. The trick is learning what commands to use, hopefully one of the books that I ordered will provide me with a list. VBA

I REALLY need help with the last four Sub's

Sub shapeTextHappySmile()
Sub shapeTextSadSmile()
Sub CertificateBuld()
Sub PutText()



Option Explicit
Dim UserName As String
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer
Dim printableSlide As Slide


Sub Initialise()
numberCorrect = 0
numberIncorrect = 0
numberPercentage = 0
numberTotal = 0
numberCorrect = numberIncorrect - numberTotal
numberTotal = (numberCorrect + numberIncorrect)
numberPercentage = ((numberCorrect / numberTotal) * 100) & "%"
End Sub


Sub TakeQuiz()
UserName = InputBox(Prompt:="Type Your Name! ")
MsgBox "Welcome To The Academic Online Tutorial Quiz " + UserName, vbApplicationModal, " Academic Online Tutorial Quiz"
ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub Correct()
MsgBox "Well Done! That the correct answer"
numberCorrect = numberCorrect + 1
ActivePresentation.SlideShowWindow.View.Next
End Sub


Sub Wrong()
MsgBox "Sorry! That was the incorrect answer"
numberIncorrect = numberIncorrect + 1
ActivePresentation.SlideShowWindow.View.Next
End Sub


Sub shapeTextHappySmile()
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer
numberCorrect = 0
numberIncorrect = 0
numberPercentage = 0
numberTotal = 0


numberCorrect = (numberTotal - numberIncorrect)
Application.ActivePresentation.Slides(40).Shapes(1).TextFrame.TextRange.Tex t = numberCorrect
numberPercentage = (numberCorrect / numberTotal) * 100
Application.ActivePresentation.Slides(40).Shapes(2).TextFrame.TextRange.Tex t = numberPercentage & "%"
End Sub


Sub shapeTextSadSmile()
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer
numberCorrect = 0
numberIncorrect = 0
numberPercentage = 0
numberTotal = 0


numberIncorrect = (numberTotal - numberCorrect)
Application.ActivePresentation.Slides(41).Shapes(1).TextFrame.TextRange.Tex t = numberIncorrect
numberPercentage = (numberCorrect / numberTotal) * 100
Application.ActivePresentation.Slides(41).Shapes(2).TextFrame.TextRange.Tex t = numberPercentage & "%"
End Sub


Sub CertificateBuld()
Dim UserName As String
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer
numberCorrect = 0
numberIncorrect = 0
numberPercentage = 0
numberTotal = 0
Dim Rdate
Rdate = Format(Date, "mmmm dd, yyyy")


If numberCorrect >= "14" Then
'Application.ActivePresentation.Slides(42).Shapes(8).TextFrame.TextRange.Te xt = " UNIVERSITY OF THE PEOPLE "

'With ActivePresentation.Slides(42).Shapes(9).TextFrame.TextRange.Text = Rdate & " ON " & Rdate & " WITH A SCORE OF " & numberPercentage & " %"


'With ActivePresentation.Slides(42).Shapes(10).TextFrame.TextRange.Text = UserName


Application.ActivePresentation.Slides(42).Shapes(8).TextFrame.TextRange.Tex t = " UNIVERSITY OF THE PEOPLE "
Application.ActivePresentation.Slides(42).Shapes(9).TextFrame.TextRange.Tex t = " ON " & Rdate & " WITH A SCORE OF " & numberPercentage & " %"
numberPercentage = (numberCorrect / numberTotal) * 100
Application.ActivePresentation.Slides(42).Shapes(10).TextFrame.TextRange.Te xt = UserName


Else
TakeQuiz
End If


End Sub


Sub PutText()
Dim UserName As String
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer
numberCorrect = 0
numberIncorrect = 0
numberPercentage = 0
numberTotal = 0
Dim Rdate
Rdate = Format(Date, "mmmm dd, yyyy")
numberCorrect = numberIncorrect - numberTotal
numberPercentage = ((numberCorrect / numberTotal) * 100)


With ActivePresentation.Slides(40)


With .Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 500, 100)
.TextFrame.TextRange.Text = numberCorrect


With ActivePresentation.Slides(40)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 500, 100)
.TextFrame.TextRange.Text = numberPercentage


'If numberCorrect => "14" Then
With ActivePresentation.Slides(42).Shapes(10).TextFrame.TextRange.Text = UserName
With ActivePresentation.Slides(42).Shapes(9).TextFrame.TextRange.Text = Rdate
'End If
End With
End With
End With
End With
PrintCertificate


End Sub

CBiscuit
03-15-2017, 11:17 PM
My PPtm is to large o upload.

albino_pygmy
03-18-2017, 04:37 PM
First off, welcome to the forum! While posting your code, please wrap them in the CODE tags, (it's the button that looks like this # )

The code is read from top to bottom, so the order of each line is important. Lets use your first subroutine in question as an example. I have made notes in between your lines.


Sub shapeTextHappySmile()
'You have already dim'd these variables outside of the subroutine, there's no need to redim them inside.
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer

'Are you sure you want to clear these variables to 0?
numberCorrect = 0
numberIncorrect = 0
numberPercentage = 0
numberTotal = 0

'If you assigned your variables to 0, everything will be 0.
numberCorrect = (numberTotal - numberIncorrect)

'You don't really need to start your code with "Application," Starting with ActivePresentation works just fine.
'Have you considered naming your shapes? Open up the Selection Pane and select a shape's name "Rectangle 1" and rename it.
'Might I suggest unique names that you can use to help you identify them in code, such as "Correct" or "Incorrect" like this:
'Application.ActivePresentation.Slides(40).Shapes("Correct").TextFrame.TextRange.Text = numberCorrect

Application.ActivePresentation.Slides(40).Shapes(1).TextFrame.TextRange.Tex t = numberCorrect

'Integers are whole numbers, with no decimals. Dividing numbers gives you decimals. You would need to convert the right side of the statement 'below as an integer, which will round your decimal to a whole number. To do this, you would use CInt() like this:
'numberPercentage = CInt((numberCorrect / numberTotal) * 100)numberPercentage = (numberCorrect / numberTotal) * 100

Application.ActivePresentation.Slides(40).Shapes(2).TextFrame.TextRange.Tex t = numberPercentage & "%"
End Sub

CBiscuit
03-18-2017, 05:57 PM
thank you,
if I understand you correctly, my code should look like the below based on your comments. Also I can remove ALL the extra "Dim entries" after I list them in the beginning under Option explicit or Public

since the variables are listed at the very beginning I do not need to list them in each subroutine correct?

I could not locate the SELECTION PANEL to label each SHAPE. I tried right mouse hoping to find the property tab on the screen and I also looked when I was in VBA script screen.

#Sub shapeTextHappySmile()
#numberCorrect = (numberTotal - numberIncorrect)
#ActivePresentation.Slides (40).Shapes ("Correct").TextFrame.TextRange.Text = numberCorrect

#numberPercentage = CInt((numberCorrect / numberTotal) * 100)
#ActivePresentation.Slides (40).Shapes ("Percentage").TextFrame.TextRange.Text=numberPercentage & "%"
#End Sub


'I tried using the "Round" command.
#numberPercentage = Round((numberCorrect / numberTotal) * 100)n


CBiscuit

CBiscuit
03-18-2017, 06:05 PM
Sir/ Madame,

for this subroutine what would be my last command before "End Sub". if the scores is equal to 70% or above, then the last command should display slide 42 "The Certificate" with the user information and current date.

.gotoslide(42)

CBiscuit

John Wilson
03-19-2017, 04:43 AM
You MUST list the variables relating score outside of all sub routines (except initialize which SHOULD set them to zero) and remove the other ones inside the subs, they should be module wide. If you do not they will be constantly reset to zero (even without the lines that do this literally)

CBiscuit
03-19-2017, 05:30 AM
You MUST list the variables relating score outside of all sub routines (except initialize which SHOULD set them to zero) and remove the other ones inside the subs, they should be module wide. If you do not they will be constantly reset to zero (even without the lines that do this literally)

I have removed the errors you have pointed out.

Thank you

CBiscuit

CBiscuit
03-22-2017, 01:35 AM
You MUST list the variables relating score outside of all sub routines (except initialize which SHOULD set them to zero) and remove the other ones inside the subs, they should be module wide. If you do not they will be constantly reset to zero (even without the lines that do this literally)

again, thank you for the help.

I decided to remove the subroutines that require the quizzer to print the certificate.

my very last problem is getting the "DATE" function to work properly.

Other than that, I think it will work.


Option Explicit
Dim UserName As String
Dim numberCorrect As Integer
Dim numberIncorrect As Integer
Dim numberPercentage As Integer
Dim numberTotal As Integer
Dim printableSlide As Slide
Dim Rdate as Date or ?
Rdate = Format(Date, "mmmm dd, yyyy")


Sub CertificateBuld()
If numberCorrect >= "14" Then
ActivePresentation.Slides(42).Shapes("UNIVERSITY OF THE PEOPLE").TextFrame.TextRange.Text = " UNIVERSITY OF THE PEOPLE "
ActivePresentation.Slides(42).Shapes("Rdate_numberPercentage").TextFrame.TextRange.Text = " ON " & Rdate & " WITH A SCORE OF " & numberPercentage & " %"
numberPercentage = Round(numberCorrect / numberTotal) * 100
numberPercentage = Round(numberCorrect / numberTotal) * 100
ActivePresentation.Slides(42).Shapes("UserName").TextFrame.TextRange.Text = UserName

Else
?
End If

John Wilson
03-22-2017, 02:20 AM
Formatting a DATE returns a String so RDate should be declared as a string

CBiscuit
03-31-2017, 09:27 AM
Formatting a DATE returns a String so RDate should be declared as a string

I made major changes and just about everything is working fine, except the below items ARE NOT showing on my blank form slide 42 - username, date, and percentage score.

The Sub Cert() is suppose to insert, the [username, date, and percentage score] onto a certificate I created on slide 42 if the person taking the quiz scores 70 or more .




Private Sub APA()
Dim Username As Integer
Dim Rdate As StringRdate = Date
Rdate = Format((Date), "mmmm dd, yyyy")
Rdate.Caption = Format((Date), "mmmm dd, yyyy")

CorrectAnswer.Caption = 0
IncorrectAnswer.Caption = 0
Ppercentage.Caption = 0
Npercentage.Caption = 0

End Sub

Sub Reset()
CorrectAnswer.Caption = 0
IncorrectAnswer.Caption = 0
Ppercentage.Caption = 0
Npercentage.Caption = 0
'Rdate.Caption = Format((Date), "mmmm dd, yyyy")
ActivePresentation.SlideShowWindow.View.Exit
End Sub

Sub Startover()
CorrectAnswer.Caption = 0
IncorrectAnswer.Caption = 0
Ppercentage.Caption = 0
Npercentage.Caption = 0
'Rdate.Caption = Format((Date), "mmmm dd, yyyy")
ActivePresentation.SlideShowWindow.View.GotoSlide 1
End Sub

Sub TakeQuiz()
Username = InputBox(Prompt:="Type Your Name! ")
MsgBox "Welcome to the Academic Online Tutorial Quiz " + Username, vbApplicationModal, "Academic Online Tutorial Quiz"
ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub Correct()
CorrectAnswer.Caption = (CorrectAnswer.Caption) + 1
Ppercentage.Caption = (CorrectAnswer.Caption) * 20
Output = MsgBox("Your Answer is correct, well done! " + Ppercentage + " %", vbOKOnly, "Correct Answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub Wrong()
IncorrectAnswer.Caption = (IncorrectAnswer.Caption) + 1
Npercentage.Caption = (IncorrectAnswer.Caption) * (-20)
Output = MsgBox("Your Answer is incorrect. " + Npercentage + " %", vbOKOnly, "Incorrect Answer")
ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub Rexit()
CorrectAnswer.Caption = 0
IncorrectAnswer.Caption = 0
Ppercentage.Caption = 0
Npercentage.Caption = 0
'Rdate.Caption = Format((Date), "mmmm dd, yyyy")
ActivePresentation.SlideShowWindow.View.Exit
End Sub

Sub Retry()
CorrectAnswer.Caption = 0
IncorrectAnswer.Caption = 0
Ppercentage.Caption = 0
Npercentage.Caption = 0
'Rdate.Caption = Format((Date), "mmmm dd, yyyy")
ActivePresentation.SlideShowWindow.View.GotoSlide (1)
End Sub

Sub Cert()
If Ppercentage.Caption >= 80 Then
ActivePresentation.SlideShowWindow.View.GotoSlide (9)
Username = (Username.Caption)
Rdate.Caption = Format((Date), "mmmm dd, yyyy")
Ppercentage.Caption = (Ppercentage.Caption)
End If 'Ppercentage <= 69
Else
ActivePresentation.SlideShowWindow.View.Quit
End Sub

Paul_Hossler
03-31-2017, 11:51 AM
Please reread #3 about using CODE tags and the [#] icon

John Wilson
04-02-2017, 12:02 AM
Also please show where you have Dim'd the values e.g. CorrectAnswer.Caption and also move Dim Username outside of any module. You should not use .Caption in any case as it has a special meaning in vba.

John Wilson
04-02-2017, 12:35 AM
It's not easy to see where your code is going but see if this is closer to what you need.




Dim Username As String
Dim CorrectAnswers As Integer
Dim IncorrectAnswers As Integer
Const TotalQuestions As Integer = 6 ' set number of questions


Sub Reset()
CorrectAnswers = 0
IncorrectAnswers = 0
ActivePresentation.SlideShowWindow.View.Exit
End Sub


Sub Startover()
CorrectAnswers = 0
IncorrectAnswers = 0
ActivePresentation.SlideShowWindow.View.GotoSlide 1
End Sub


Sub TakeQuiz()
Call Retry
Username = InputBox(Prompt:="Type Your Name!")
MsgBox "Welcome to the Academic Online Tutorial Quiz " & Username, vbApplicationModal, "Academic Online Tutorial Quiz"
ActivePresentation.SlideShowWindow.View.Next
End Sub


Sub Correct()
Dim Percent As Single
CorrectAnswers = (CorrectAnswers) + 1
Percent = Round(CorrectAnswers / TotalQuestions * 100, 1)


MsgBox "Your Answer is correct, well done! Current score " & Percent & " %", vbOKOnly, "Correct Answer"
ActivePresentation.SlideShowWindow.View.Next
End Sub


Sub Wrong()
Dim Percent As Single
IncorrectAnswers = (IncorrectAnswers) + 1
Percent = Round(CorrectAnswers / TotalQuestions * 100, 1)
MsgBox "Your Answer is incorrect. Current score " & Percent & " %", vbOKOnly, "Incorrect Answer"
ActivePresentation.SlideShowWindow.View.Next
End Sub


Sub Retry()
CorrectAnswers = 0
IncorrectAnswers = 0
ActivePresentation.SlideShowWindow.View.GotoSlide (1)
End Sub


Sub Cert()
Dim Percent As Single
Percent = CorrectAnswers / TotalQuestions * 100
If Percent > 70 Then
Percent = Round(Percent, 1)
ActivePresentation.SlideShowWindow.View.GotoSlide (9)
' assumes there are two shape that can have text eg Title & Content slide
ActivePresentation.Slides(9).Shapes(2).TextFrame.TextRange.Text = _
"Name: " & Username & vbCrLf & _
"Date: " & Format(Date, "mmmm dd, yyyy") & vbCrLf & _
"Number Correct: " & CorrectAnswers & " Out of: " & TotalQuestions & vbCrLf & _
"Percentage: " & Percent & "%"
Else
ActivePresentation.SlideShowWindow.View.Exit
End If
End Sub