Bonjour à tous,

J'aimerai optimiser le code d'une fonctionnalité de mon fichier: changer le fond d'une plage de cellule quand une cellule de la plage est sélectionnée...

J'ai un questionnaire qui peut comporter plusieurs questions et sous-questions (avec un nombre de réponse qui est être variable). Quand l'utilisateur a fait son choix il clique sur une réponse et la cellule (plage) change de fond, cela afin de voir au premier coup d'oeil le choix de l'utilisateur.

Et cela pour toutes les questions et sous-questions.

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
Const DEBUT_REP_QA1 As Integer = 3
Const FIN_REP_QA1 As Integer = 6
Const DEBUT_REP_QA2 As Integer = 8
Const FIN_REP_QA2 As Integer = 12
 
m_row = Target.Row
m_col = Target.Column
 
If m_col >= 1 And m_col <= 2 Then
    'Question A-1
    If m_row >= DEBUT_REP_QA1 And m_row <= FIN_REP_QA1 Then
        If Cells(m_row, m_col).Value <> "" Then
            'Le fond devient blanc
            Range(Cells(DEBUT_REP_QA1, 1), Cells(FIN_REP_QA1, 2)).Columns.Interior.ThemeColor = xlThemeColorDark1
 
            'Le fond devient gris
            Range(Cells(m_row, 1), Cells(m_row, 2)).Columns.Interior.ThemeColor = xlThemeColorAccent3
        End If
    End If
 
    'Question A-2
    If m_row >= DEBUT_REP_QA2 And m_row <= FIN_REP_QA2 Then
        If Cells(m_row, m_col).Value <> "" Then
            'Le fond devient blanc
            Range(Cells(DEBUT_REP_QA2, 1), Cells(FIN_REP_QA2, 2)).Columns.Interior.ThemeColor = xlThemeColorDark1
 
            'Le fond devient gris
            Range(Cells(m_row, 1), Cells(m_row, 2)).Columns.Interior.ThemeColor = xlThemeColorAccent3
        End If
    End If
End If
End Sub
Le code ci-dessus montre bien le problème que j'ai actuellement... la redondance du code.

A noter que les plages des réponses ne sont pas contiguës...

J'ai essayé divers solutions (boucle, tableau) mais comme je suis nouveau en VBA je ne suis pas parvenu à la trouver.

Je joins également mon fichier (questionnaire_Dev.xlsm), en espérant que quelqu'un trouvera une solution à mon problème.

Merci d'avance