Consulting

Results 1 to 13 of 13

Thread: Newbie Needs Help with Powerpoint code

  1. #1

    Newbie Needs Help with Powerpoint code

    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

  2. #2
    My PPtm is to large o upload.

  3. #3
    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.Text = 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.Text = numberPercentage & "%"
    End Sub

  4. #4
    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

  5. #5
    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

  6. #6
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    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)
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  7. #7

    VBA Help

    Quote Originally Posted by John Wilson View Post
    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

  8. #8
    Quote Originally Posted by John Wilson View Post
    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

  9. #9
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    Formatting a DATE returns a String so RDate should be declared as a string
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  10. #10

    More help needed with powerpoint VBA script.

    Quote Originally Posted by John Wilson View Post
    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
    Last edited by Paul_Hossler; 03-31-2017 at 11:54 AM. Reason: Added CODE tags

  11. #11
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,726
    Location
    Please reread #3 about using CODE tags and the [#] icon
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #12
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    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
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  13. #13
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •