Application.intersect , si et seulement si

Bonjour Messieurs, Dames!

Je fais actuellement un petit programme en VBA afin de rendre une feuille excel sous format formulaire.

Je m'explique :
Colonne A : Question
Colonne B : "OUI"
Colonne C : "NON"

Lorsque j'ouvre mon classeur, l'utilisateur répond aux questions en cliquant sur la colonne B si sa réponse est positive ou en cliquant sur la colonne C si sa réponse est négative. La cellule cliquée devient à fond vert.
La modification est possible (on peut changer sa réponse, la sélection de l'une des 2 cellules entraine la déselection de l'autre...)

Cela fonctionne à merveille.

Cependant, je cherche à optimiser ce code car j'ai un soucis:
Si par inadvertance je fais une sélection de plusieurs cellules comprenant des cellules de la colonne B et/ou de la colonne C, l'ensemble de la sélection devient à fond vert...

Je souhaiterais qu'une telle sélection n'entraine aucune modification de couleur (j'espere bien m'exprimer...)

Voici mon code actuel:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim TbOUINON Dim i As Integer TbOUINON = Array("B5:H5", "B6:C6", "B7:C7", "B8:C8", "B9:C9", "B10:C10", "B11:C11", "B12:C12", "B13:C13", "D14:E14", "J7:K7", "I8:K8", "B20:C20", "B21:C21", "B24:E24", "B25:E25", "B26:E26", "B27:E27", "B28:E28", "B29:E29", "B30:E30", "B31:E31", "J30:K30", "M5:N5", "O5:P5", "Q5:R5", "S5:U5", "M6:N6", "O6:R6", "M7:N7", "O7:Q7", "T7:U7", "M8:N8", "R8:S8", "M9:N9", "R9:S9", "M10:N10", "O10:P10", "T10:U10", "M11:N11", "R11:S11", "M12:N12", "R12:S12", "M13:N13", "R13:S13", "M14:N14", "M15:N15", "R15:S15", "M16:N16", "R16:S16", "O19:P19", "S19:T19", "M21:N21", "R21:S21", "M23:N23", "Q23:R23", "S23:U23", "M24:N24", "Q24:R24", "S24:U24", "M25:N25", "Q25:R25", "S25:U25", "M26:N26", "Q26:R26", "M27:N27", "Q27:R27", "M29:N29", "O29:R29", "M30:N30", "O30:R30", "M31:N31", "O31:R31", "M32:N32", "O32:R32", "M33:N33", "M35:N35", "O35:Q35", "T35:U35", "M36:N36", "O36:Q36", "T36:U36", "L38:U38", "M40:N40", "O40:R40", "M41:N41", "M42:N42", "M44:N44", "R44:S44") For i = 0 To UBound(TbOUINON) If Not Application.Intersect(Target, Range(TbOUINON(i))) Is Nothing Then With Target If Selection.Interior.ColorIndex = xlNone Then Range(TbOUINON(i)).Interior.ColorIndex = xlNone Selection.Interior.ColorIndex = 43 Else Selection.Interior.ColorIndex = xlNone End If End With End If Next i End Sub

Bonjour,

Avec ce test

Code:

if Target.Count>1 then exit sub

Merci !!! :)

C'est exactement ça !!! :)