Bonjour,

il y a quelques mois maintenant, j'avais trouvé ce code vba qui marche très bien sur internet.
Il y a des questions avec des cases à cocher : oui et non(cases rondes).
Il compte les oui (valeur : 1 point), puis les non (valeur: 0 point).
J'aimerais savoir si quelqu'un peux m'aider car je souhaites rajouter une case à cocher: je sais pas (valeur: 0 point)...
Voici le code ci-dessous: MERCI
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Option Explicit
 
Sub feuil2()
 
    Dim Fe As Worksheet
    Dim TblRecup()
    Dim Tbl()
    Dim G As Shape
    Dim S As Shape
    Dim NomGroupe As String
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim Test As Long
    Dim NBOui As Integer
    Dim NBNon As Integer
 
    Set Fe = ActiveSheet
 
 
    'les groupes étant réalisés, ils ne forment plus qu'un
    'avec les Shapes qu'ils contiennent
    For Each G In Fe.Shapes
 
        'parcours de la collection par groupe
        For Each S In G.GroupItems
 
            'récupération du nom de chaque shape constituant le groupe en court
            'afin de reconstituer le groupe après récup de la valeur
            I = I + 1
            ReDim Preserve Tbl(1 To I)
            Tbl(I) = S.Name
 
        Next S
 
        NomGroupe = G.Name
 
        'pour avoir accès à la valeur de chaque bouton d'option
        'on doit les dissocier du groupe
        G.Ungroup
 
        'récupération de la valeur
        For J = 1 To UBound(Tbl)
 
            'le Frame n'ayant pas de propriété "Value" il faut gérer l'erreur
            On Error Resume Next
            Test = Fe.Shapes(Tbl(J)).ControlFormat.Value
 
            If Err.Number = 0 Then
 
                K = K + 1
                ReDim Preserve TblRecup(1 To 2, 1 To K)
                TblRecup(1, K) = Fe.Shapes(Tbl(J)).TextFrame.Characters.Caption
                TblRecup(2, K) = Fe.Shapes(Tbl(J)).ControlFormat.Value
 
            End If
 
        Next J
 
        'reconstitution du groupe
        Fe.Shapes.Range(Tbl()).Group.Name = NomGroupe
 
        'prépare pour le suivant
        I = 0
        Erase Tbl
 
    Next G
 
    'comptage des Oui et Non
    For I = 1 To UBound(TblRecup, 2)
 
        If TblRecup(2, I) = 1 And TblRecup(1, I) = "Oui" Then
 
            NBOui = NBOui + 1
 
        ElseIf TblRecup(2, I) = 1 And TblRecup(1, I) = "Non" Then
 
            NBNon = NBNon + 1
 
        End If
 
    Next I
 
    Sheets("Attitude").Cells(33, 12).Value = NBOui
    Sheets("Total").Cells(10, 9).Value = NBOui
 
 
End Sub