Hi,
I need your help.

In this macro, I would like the compilation of the inputbox to be binding (the field must be always completed):

Dim numCorrect As Integer
Dim numIncorrect As Integer
Dim userName As String
Dim qAnswered As Boolean

Sub SaveToExcel()    'ADDED
    Dim oXLApp As Object
    Dim oWb As Object
    Dim row As Long
    Dim strTitle As String
    Dim strdate As String


With ActivePresentation.Slides(1).Shapes("Title")
strTitle = .TextFrame.TextRange
If strTitle = "" Then strTitle = "Not Found"
End With
    strdate = Format(Date, "dd/mm/yyyy")
    Set oXLApp = CreateObject("Excel.Application")
    'On a Mac change \ to : in the following line
    Set oWb = oXLApp.Workbooks.Open(ActivePresentation.Path & "\" & "AvvioCorso.xlsm")
    If oWb.Worksheets(1).Range("A1") = "" Then
        oWb.Worksheets(1).Range("A1") = "Title"
        oWb.Worksheets(1).Range("B1") = "Date"
        oWb.Worksheets(1).Range("C1") = "Name"
        oWb.Worksheets(1).Range("D1") = "Number Correct"
        oWb.Worksheets(1).Range("E1") = "Number Incorrect"
        oWb.Worksheets(1).Range("F1") = "Percentage"
    End If
    row = 2
    While oWb.Worksheets(1).Range("A" & row) <> ""
        row = row + 1
    Wend
    oWb.Worksheets(1).Range("A" & row) = strTitle
    oWb.Worksheets(1).Range("B" & row) = strdate
    oWb.Worksheets(1).Range("C" & row) = userName
    oWb.Worksheets(1).Range("D" & row) = numCorrect
    oWb.Worksheets(1).Range("E" & row) = numIncorrect
    oWb.Worksheets(1).Range("F" & row) = Format(100 * (numCorrect / (numCorrect + numIncorrect)), "##.#") & "%"
    oWb.Save
    oWb.Close
End Sub

Sub GetStarted()
    Initialize
    YourName
    ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub Initialize()
    numCorrect = 0
    numIncorrect = 0
    qAnswered = False
End Sub

Sub YourName()
    userName = InputBox("Scrivi il tuo Nome e Cognome")
End Sub

Sub RightAnswer()
    YourName
    If qAnswered = False Then
        numCorrect = numCorrect + 1
    End If
    qAnswered = False
    MsgBox "Complimenti " & userName & ". Richiedi al docente il test di apprendimento"
    Feedback
End Sub

Sub WrongAnswer()
    YourName
    If qAnswered = False Then
        numIncorrect = numIncorrect + 1
    End If
    qAnswered = True
    MsgBox "Attendere prego"
    gotoSlide 'vai a slide specifica
    SaveToExcel 'ADDED
End Sub


Sub Feedback()
    MsgBox "Aggiornamento in corso"
    SaveToExcel 'ADDED
End Sub

Sub NameIt()
    Dim sResponse As String

    With ActiveWindow.Selection.ShapeRange(1)
        sResponse = InputBox("Rename this shape to ...", "Rename Shape", .Name)
        Select Case sResponse
            ' blank names not allowed
            Case Is = ""
                Exit Sub
            ' no change?
            Case Is = .Name
                Exit Sub
            Case Else
                On Error Resume Next
                .Name = sResponse
                If Err.Number <> 0 Then
                    MsgBox "Unable to rename this shape"
                End If
        End Select
    End With

End Sub

Sub gotoSlide()
    Application.SlideShowWindows(1).View.gotoSlide Index:=4
End Sub
Where and what to change?

Thanks in advance.
bg66