Un super script
Sub Fin()
Dim xcl As Object 'Déclaration de la variable qui fera référence à Excel
Dim ExcelNonOuvert As Boolean
'La boîte de dialogue
x = MsgBox("Vous avez répondu correctement à " & Total & "
questions sur " & Question - 1 & "." _
& Chr(13) & "Vous avez donc " & Int(Total / (Question - 1) * 20)
& " sur 20." _
& Chr(13) & "Cliquez sur le bouton OK", , "Fin du
questionnaire")
Fichier = Nom & ".txt"
'Première sauvegarde des résultats
'L'insertion des données dans le fichier Excel
On Error Resume Next
Set xcl = GetObject(, "Excel.Application")
'Si Excel est déjà ouvert, GetObject produit une erreur
If Err.Number <> 0 Then ExcelNonOuvert = True
Err.Clear ' Efface la référence de l'erreur
'****** INTRODUIRE DANS LA LIGNE SUIVANTE LE CHEMIN D'ACCES AU FICHIER SUR VOTRE SYSTEME
Set xcl = GetObject("c:\QCM\resultats.XLS")
'Insertion d'une colonne pour introduire les résultats
xcl.Application.Visible = True
xcl.Parent.Windows(1).Visible = True
xcl.Application.Cells.Find(What:="moyenne").Activate
xcl.Application.Selection.EntireColumn.Insert
xcl.Application.ActiveCell.Value = Nom
xcl.Application.ActiveCell.Offset(1, 0).Range("A1").Select
'Introduction des données dans la feuille de calcul
For i = 1 To Question - 1
xcl.Application.ActiveCell.Value = Points(i)
xcl.Application.ActiveCell.Offset(1, 0).Range("A1").Select
Next i
xcl.Application.ActiveWorkbook.Save 'Enregistrement du fichier Excel
'Fermeture d'Excel s'il n'était pas ouvert
If ExcelNonOuvert = True Then xcl.Application.Quit
Set xcl = Nothing
'Deuxième sauvegarde des résultats
'dans un fichier texte
'portant comme nom celui de la personne qui a répondu au questionnaire
Open Fichier For Output Shared As #1
Write #1, Nom
For i = 1 To Question - 1
Write #1, Points(i)
Next i
Close #1
End Sub
