This will need a little more work but should give a start.
Code:
Dim numCorrect As Long
Dim numincorrect As Long
Dim userNameType As String
Dim rayResult(1 To 10) As String
Dim count As Long
Sub SaveToExcel() 'ADDED
Dim oXLApp As Object
Dim oWb As Object
Dim row As Long
Dim L As Long
Set oXLApp = CreateObject("Excel.Application")
'On a Mac change \ to : in the following line
Set oWb = oXLApp.Workbooks.Open(ActivePresentation.Path & "\" & "result.xlsx")
If oWb.Worksheets(1).Range("A1") = "" Then
oWb.Worksheets(1).Range("A1") = "Name"
oWb.Worksheets(1).Range("B1") = ""
oWb.Worksheets(1).Range("C1") = "Date"
oWb.Worksheets(1).Range("D1") = "Number Correct"
oWb.Worksheets(1).Range("E1") = "Number Incorrect"
oWb.Worksheets(1).Range("F1") = "Percentage"
For L = 1 To 10
oWb.Worksheets(1).Range("F1").Offset(0, L) = "Q: " & L
Next L
End If
row = 2
While oWb.Worksheets(1).Range("A" & row) <> ""
row = row + 1
Wend
oWb.Worksheets(1).Range("A" & row) = userNameType
oWb.Worksheets(1).Range("B" & row) = UserName()
oWb.Worksheets(1).Range("C" & row) = Date
oWb.Worksheets(1).Range("D" & row) = numCorrect
oWb.Worksheets(1).Range("E" & row) = numincorrect
oWb.Worksheets(1).Range("F" & row) = 100 * (numCorrect / (numCorrect + numincorrect))
For L = 1 To 10
oWb.Worksheets(1).Range("F" & row).Offset(0, L) = rayResult(L)
Next L
oWb.Save
oWb.Close
End Sub
Sub GetStarted()
Initialize
YourName
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Initialize()
numCorrect = 0
numincorrect = 0
qAnswered = False
count = 0
End Sub
Sub YourName()
userNameType = InputBox("Type your name")
End Sub
Sub RightAnswer()
If qAnswered = False Then
numCorrect = numCorrect + 1
count = count + 1
rayResult(count) = "CORRECT"
End If
qAnswered = False
'MsgBox "Your doing well, " & userNameType
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub WrongAnswer()
If qAnswered = False Then
numincorrect = numincorrect + 1
count = count + 1
rayResult(count) = "INCORRECT"
End If
qAnswered = False 'if giving answer change back to True
'MsgBox "Try to do better next time, " & userNameType
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Feedback()
MsgBox "You got " & numCorrect & " out of " _
& numCorrect + numincorrect & ", " & userNameType
SaveToExcel 'ADDED
End Sub
Public Function UserName()
UserName = Environ$("UserName")
End Function
Sub End_Test()
With Application
For Each w In .Presentations
w.Save
Next w
.Quit
End With
End Sub