Discussion :

[matinho]

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 :



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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Philippe Tulliez]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[matinho]

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 :

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
 
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 :/

[Philippe Tulliez]

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 :

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
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

[matinho]

Voici le code final :

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
 
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