Système de case a cocher

Version imprimable

29/06/2014, 11h33
matinho

1 pièce(s) jointe(s)

Système de case a cocher
Bonjour à tous,

Cela fait un petit moment que je cherche une solution à ce que je souhaite obtenir.

Mais je n'ai pas la logique nécessaire pour arriver à mon but final :(

En faite, je cherche à avoir ceci :

Pièce jointe 149941

Pour une plage définie (B2:C4), quand je fais un simple clic gauche, par exemple, sur la case B2, la case se coche automatique avec une petite croix "X" et le fond devient vert (vu que c'est la colonne "OK"). Vise versa quand on clique dans la colonne "KO", une petite croix et un fond rouge.

Mais le problème, c'est que je n'arrive déjà pas à faire des conditions, exemple :

Quand on clique sur B2, par défaut la celulle C2 ce vide. Idem quand on clique C2, la celulle B2 doit aussi se vider ...

Après avoir fait des tests, j'ai ce code si :
Code:

1 2 3 4 5 6 7 8 9 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 Then Target.Offset(0, 0) = "X" Else Target.Offset(0, 1) = "" End If End Sub
J'ai bien ma petite croix dans la seconde colonne mais après je n'ai pas trop les compétences pour trouver le bon algorithme :(

Merci de votre aide et bon dimanche ;)

matinho

Bonjour,
Voici un code qui fonctionne si on fait un double clic sur une cellule des colonnes 2, 3, 5 et 6 dans les limites de la région de la plage A2:F4
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Application.Intersect(Target, Me.Range("A2:F4")) Is Nothing Or Target.Count > 1 Then Exit Sub Cancel = False With Target Select Case .Column Case 2, 5 .Value = IIf(.Value = "X", "", "X"): .Offset(0, 1) = IIf(.Value = "X", "", "X") Case 3, 6 .Value = IIf(.Value = "X", "", "X"): .Offset(0, -1) = IIf(.Value = "X", "", "X") End Select End With Cancel = True End Sub
Ce même code fonctionne également pour la procédure événementielle Worksheet_BeforeRightClick à condition bien entendu de le copier à l'intérieur de cette procédure

Bonjour Monsieur Tulliez,

Merci à vous car le code fonctionne très bien :)

J'ai étendu les cases a sélectionner (avec plusieurs autres colonnes) et j'ai pu mettre des fantaisies pour rendre propre ma feuille de calcul, j'ai fait ceci :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Application.Intersect(Target, Me.Range("A6:O28")) Is Nothing Or Target.Count > 1 Then Exit Sub Cancel = False With Target Select Case .Column Case 2, 5, 8, 11, 14, 17 .Value = IIf(.Value = "X", "", "X"): .Offset(0, 1) = IIf(.Value = "X", "", "X") .Font.Bold = True .Interior.Color = RGB(0, 192, 0) .Font.Size = 11 .HorizontalAlignment = xlCenter Case 3, 6, 9, 12, 15, 18 .Value = IIf(.Value = "X", "", "X"): .Offset(0, -1) = IIf(.Value = "X", "", "X") .Font.Bold = True .Interior.Color = RGB(255, 0, 0) .Font.Size = 11 .HorizontalAlignment = xlCenter End Select End With Cancel = True End Sub
Est ce propre au niveau du code ? ou c'est "bordélique" ^^

Pour les colonnes "OK" de gauche, nous avons du vert et les colonnes "KO" de droite du rouge.

J'essaie de mettre ce code : .Interior.Color = RGB(255, 255, 255) pour mettre du blanc la ou il n'y a pas de croix, mais j'ai toujours des erreurs de syntaxe :/

Bonjour,
Il existe des constantes pour les couleurs le blanc c'est vbWhite, le rouge vbRed etc...
vbGreen n'est pas le même vert que RGB(0, 192, 0), à toi de voir.
Pour les couleurs, tu dois faire la même chose que pour les croix. Il faut gérer l'autre colonne.
J'ai mis en rouge les deux lignes dont j'ai changé le code. A toi de faire le changement dans l'autre partie.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Application.Intersect(Target, Me.Range("A6:O28")) Is Nothing Or Target.Count > 1 Then Exit Sub Cancel = False With Target Select Case .Column Case 2, 5, 8, 11, 14, 17 .Value = IIf(.Value = "X", "", "X"): .Offset(0, 1) = IIf(.Value = "X", "", "X") .Font.Bold = True .Interior.Color = vbGreen ' RGB(0, 192, 0) .Font.Size = 11 .HorizontalAlignment = xlCenter Case 3, 6, 9, 12, 15, 18 .Value = IIf(.Value = "X", "", "X"): .Offset(0, -1) = IIf(.Value = "X", "", "X") .Font.Bold = True .Interior.Color = IIf(.Value = "X", vbRed, vbWhite) ' RGB(255, 0, 0) .Offset(0, -1).Interior.Color = IIf(.Value = "X", vbWhite, vbGreen) .Font.Size = 11 .HorizontalAlignment = xlCenter End Select End With Cancel = True End Sub

Voici le code final : :)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Application.Intersect(Target, Me.Range("A6:O28")) Is Nothing Or Target.Count > 1 Then Exit Sub
   Cancel = False
   With Target
    Select Case .Column
     Case 2, 5, 8, 11, 14, 17
      .Value = IIf(.Value = "X", "", "X"): .Offset(0, 1) = IIf(.Value = "X", "", "X")
      .Font.Bold = True
      .Interior.Color = IIf(.Value = "X", vbGreen, vbWhite) ' RGB(255, 0, 0)
      .Offset(0, 1).Interior.Color = IIf(.Value = "X", vbWhite, vbRed)
      .Font.Size = 11
      .HorizontalAlignment = xlCenter
     Case 3, 6, 9, 12, 15, 18
      .Value = IIf(.Value = "X", "", "X"): .Offset(0, -1) = IIf(.Value = "X", "", "X")
      .Font.Bold = True
      .Interior.Color = IIf(.Value = "X", vbRed, vbWhite) ' RGB(255, 0, 0)
      .Offset(0, -1).Interior.Color = IIf(.Value = "X", vbWhite, vbGreen)
      .Font.Size = 11
      .HorizontalAlignment = xlCenter
    End Select
   End With
   Cancel = True
End Sub

Tout fonctionne comme il faut, merci encore à vous ;)