[PPTM] Inputbox con compilazione campo obbligatoria

[BG66]

Ciao a tutti,
nel macro che segue vorrei rendere obbligatorio la compilazione dell'inputbox.
Cosa devo modificare?

Codice: Seleziona tutto

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

Grazie in anticipo.

PS Questa richiesta è presente dal 12/05/18 sulla sezione Powerpoint di VBA Express ma senza risposta quindi se è crossposting prego non tenerla in considerazione.

[Marius44]

Ciao Gene
strano che non hai allegato il file!

Devi inserire una condizione che individui la mancanza di inserimento nell'INPUTBOX in questa sub

Codice: Seleziona tutto

Sub YourName()
    flag = 0                   '<== riga aggiunta
    userName = InputBox("Scrivi il tuo Nome e Cognome")
    If username ="" Then flag = 1    '<== riga aggiunta
End Sub


nella macro chiamante

Codice: Seleziona tutto

Sub GetStarted()
    Initialize
    YourName
    If flag = 1 Then Exit Sub     '>== riga aggiunta
    ActivePresentation.SlideShowWindow.View.Next
End Sub

Tieni presente che la variabile flag deve essere pubblica (ma sarebbe meglio se la Sub YourName venisse cambiata in Function

Ciao,
Mario

[Anthony47]

Ovviamente si puo' evitare di modificare la Sub YourName e lavorare solo sulla Sub GetStarted:

Codice: Seleziona tutto

Sub GetStarted()
    Initialize
    YourName
    If userName = "" Then
        MsgBox ("Obbligatorio inserire lo UserName, la procedura viene abortita")
        Exit Sub
    End If
    ActivePresentation.SlideShowWindow.View.Next
End Sub

Trovo anche pericoloso che si usi come nome di una variabile (userName) una parola chiave (la "proprietà" UserName); rinomina in myUser.

Ciao

[Marius44]

Ciao Anthony
come sempre occhio di lince. Io non avevo fatto caso al nome della variabile.
Ma una cosa vorrei chiederti: non sarebbe stato meglio usare una Function al posto della Sub YourName?

Ciao,
Mario

[BG66]

Ciao a tutti.
Ho provato entrambe le soluzioni ma sbaglio qualcosa .
Esempio:
nell'ultima slide:
1) scelgo NO,
2)non inserisco il nome,
3) clicco su ok
.....prosegue....facendomi i complimenti, etc, etc.

Prova Anthony: https://www.dropbox.com/s/t8pw1rz673uijcl/UD04_Forum_Anthony.pptm?dl=0

Prova Mario: https://www.dropbox.com/s/445k16vpu0cdqs8/UD04_Forum_Mario.pptm?dl=0

File excel -> dove scrive alcune informazioni (da posizionare nella stessa cartella dei file PPT):https://www.dropbox.com/s/2dvm0sx08rn7w6m/AvvioCorso.xlsm?dl=0

Grazie immenso per l'aiuto.

[Anthony47]

Nel PP che hai allegato la Sub GetStarted non viene mai attivata; avendo noi posizionato la verifica dello username in quella Sub e' evidente che ...veniamo bellamente ignorati.

Vedo che invece tu parti dalla Sub RightAnswer (di cui ignoravamo l'esistenza); quindi dobbiamo qui inserire quanto avevamo posizionato in GetStarted; cioe':

Codice: Seleziona tutto

Sub RightAnswer()
Debug.Print "R_A"
    YourName
    If qAnswered = False Then
        numCorrect = numCorrect + 1
    End If
    qAnswered = False
    If userName = "" Then
        MsgBox ("User Name obbligatorio; NON SO CHE FASE VIENE abortita")
        Exit Sub
    End If
   MsgBox "Complimenti " & userName & ". Richiedi al docente il test di apprendimento"
    Feedback
End Sub


Tuttavia devi adattare il suggerimento alla tua situazione, perche' (a parte che non so il significato della Sub GetStarted) nel modo che ho suggerito potrebbe darsi che l'utente rimanga intrappolato nella presentazione e non so se questo e' giusto o sbagliato.

Ciao

[BG66]

Ciao Anthony,

...........nel modo che ho suggerito potrebbe darsi che l'utente rimanga intrappolato nella presentazione e non so se questo e' giusto o sbagliato.

Se l'utente non ha voglia di scrivere il suo pezzettino è giusto che resti a vita nel PPT .

Scherzi a parte faccio qualche tests e restituisco feedback.

Grazie ancora e a presto.

[BG66]

[RISOLTO]
Ciao,
confermo che l'obiettivo è stato raggiunto.

Un Grazie Immenso.