1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
| Sub correction()
Dim rep_ok As Integer 'compteurs bonnes reponses
Dim rep_nok As Integer 'compteurs mauvaises reponses
Dim rok As Integer 'variable boucle verif question
Dim lq As Integer 'variable boucle lecture question
Dim text_rep_ok As String 'texte de la reponse valide
Dim text_rep_chbx As String 'texte de la reponse cochée
Dim lect_quest As Integer 'index pour lecture de la question
Dim text_quest As String 'texte de la question presente dans le questionnaire
Dim l_quest As Integer 'ligne de la question dans la feuille question
Dim name_chbx As String 'nom de la checkbox a verifier
Dim rep_nbr As Integer 'colonne rep numero ok
Dim comp As Integer 'comparaison numero de reponse de la checkbox / reponse OK
Dim tab_valok() As Variant 'tableau ou sont ecrit les reponse valides
Dim nb_sep As Integer 'nombre de separation dans la case
Dim nbre_rep_ok 'nombre reponse ok
Dim comp_rep_ok 'reponse ok pour la question en cours de verification
Dim comp_rep_nok 'reponse nok pour la question en cours de verification
Dim rep As Integer 'nombre de reponse pour la question en cours
Dim rep_string As String 'conversion en string nombre de reponse pour la question en cours
Dim x1
Dim c
nbre_question = Sheets("Questionnaire").Range("k2")
'RAZ bonnes reponses rep_ok
rep_ok = 0
'RAZ mauvaises reponses rep_nok
rep_nok = 0
'redimensionnement du tableau en fonction du nombre total de question
ReDim tab_valok(nbre_question)
'selection 1ere cellule colonne A
'Sheets("Questionnaire").Select
Sheets("Questionnaire").Cells(1, 1).Select
lect_quest = 1
'start boucle 1 verif question
For rok = 1 To nbre_question
'raz text_rep_ok et text_rep_chbx
text_rep_ok = ""
text_rep_chbx = ""
' recherche de la question suivante
lect_quest = Sheets("Questionnaire").Cells(lect_quest, 1).End(xlDown).Row
'texte de la question
text_quest = Sheets("Questionnaire").Cells(lect_quest, 1).Text
'rechercher ligne de la question dans feuille question
Set c = Sheets("questions").Range("A:A").Find(What:=text_quest, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
'ligne de la question dans la feuille question
l_quest = c.Row
'ecriture des reponses valides dans un tableau de variables
nb_sep = nbstr(",", Sheets("questions").Cells(l_quest, 3))
nbre_rep_ok = nb_sep + 1
tab_valok(rok) = Split(Sheets("questions").Cells(l_quest, 3).Value, ",")
'nombre de reponse possibles
nbre_rep = Sheets("questions").Cells(l_quest, 2).Value
'verification des cases cochées
'RAZ des variables indiquant si la question en cours de verification est bien repondu
comp_rep_ok = 0
comp_rep_nok = 0
'boucle de test des chaques case à cochées de la question en cours de verification
For rep = 1 To nbre_rep
'selection de la checkbox
name_chbx = "Q" & (l_quest - 1) & "Rep" & rep
'Sheets("Questionnaire").Activate
Sheets("Questionnaire").Shapes(name_chbx).Select
'conversion numero de reponse de la checkbox
rep_string = Format(rep)
'RAZ comparaison numero de reponse de la checkbox / reponse OK
comp = 0
'boucle comparaison numero de reponse de la checkbox / reponse OK
For x1 = 0 To nbre_rep_ok - 1
If tab_valok()(rok)(0 + x1) = rep_string Then
comp = 1
End If
Next
'MAJ variables indiquant si la question en cours de verification est bien repondu
If Selection.Value = 1 And comp = 1 Then 'case cochée et reponse ok
comp_rep_ok = 1
ElseIf Selection.Value = -4146 And comp = 0 Then 'case non cochée et reponse nOK
comp_rep_ok = 1
Else 'erreur de reponse !
comp_rep_nok = 1
End If Next
'mise à jour des compteur de bonne réponse / mauvaise réponse
If comp_rep_ok = 1 And comp_rep_nok = 0 Then
rep_ok = rep_ok + 1 'bonne réponse +1
ElseIf comp_rep_nok = 1 Then
rep_nok = rep_nok + 1 'mauvaise réponse +1
End If
Next
'affichage du résultat
MsgBox "nombre de bonnes reponses >> " & rep_ok & (Chr(13) & Chr(10)) & "nombre de mauvaises reponses >> " & rep_nok
End Sub |
Partager