Check box automatique en double

[anthoYS]

Bonjour,

En fait j'ai insérer un code permettant, que par double clic, une cellule se colore.
Or, ma requête, est que la cellule peut se colorer, soit d'une couleur (vert), soit d'une autre (rouge), c'est selon. Ici, je ne suis parvenu à insérer le code que pour la couleur verte.

Donc, en fait dans le fichier je dresse le problème.

Merci par avance de bien vouloir y jeter un oeil et de m'aider si vous pouvez.

A+ peut-être.

 

[Pierrot93]

Re : Check box automatique en double

Bonsoir Anthoys

essaye peut être ainsi, si j'ai bien compris :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, [H:H]) Is Nothing Then
    Target.Value = IIf(Not Target.Value = "þ", "þ", "o")
    Target.Offset(0, -4).Interior.ColorIndex = IIf(Target.Value = "þ", 4, xlNone)
Cancel = True
End If
End Sub

bonne soirée
@+

 

[tototiti2008]

Re : Check box automatique en double

Bonjour anthoys,

peut-être un truc du genre :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True ' le Double click ne sert qu'a ça
If Not Application.Intersect(Target, [H4:I65536]) Is Nothing Then 'ne concerne que les colonnes H et I
Target.Value = IIf(Target.Value = "þ", "o", "þ") 'si la cellule est = þ au _
double click elle devient o au double click suivant elle redevient þ etc...
    If Target.Value = "þ" Then 'si la cellule = þ
        Range("D" & Target.Row).Interior.ColorIndex = IIf(Target.Column = 8, 4, 3)
        ' colorie en gris la plage de cellules da A à C
            Else ' sinon
        Range("D" & Target.Row).Interior.ColorIndex = xlNone
        ' remet la couleur d'origine sur cette même plage
    End If ' Fin de la 1ère condition
End If ' fin de la 2ème condition
End Sub

Comme tu n'as pas précise ce qu'il devait faire quand les 2 sont cochés, je n'ai pas trop géré...

 

[Pierrot93]

Re : Check box automatique en double

Re

aarf, pour les 2 colonnes :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, [H:H]) Is Nothing Then
    Target.Value = IIf(Not Target.Value = "þ", "þ", "o")
    Target.Offset(0, -4).Interior.ColorIndex = IIf(Target.Value = "þ", 4, xlNone)
Cancel = True
End If
If Not Application.Intersect(Target, [I:I]) Is Nothing Then
    Target.Value = IIf(Not Target.Value = "þ", "þ", "o")
    Target.Offset(0, -5).Interior.ColorIndex = IIf(Target.Value = "þ", 3, xlNone)
Cancel = True
End If
End Sub

 

[tototiti2008]

Re : Check box automatique en double

Re,
Bonjour Pierrot,

en effet il est judicieux de mettre le Cancel = True dans le If... et tu as bien simplifié le code.
mais par contre ton code ne gère pas la colonne I, bref je pense qu'il faut mixer nos 2 codes

Edit : Bing

 

[Pierrot93]

Re : Check box automatique en double

Re, bonsoir toto

les 2, voir mon post de 18h04... mais bon à voir si résultat attendu...

 

[Pierrot93]

Re : Check box automatique en double

Re

pour le fun, en supposant que les "checbox" s'excluent mutuellement...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("H:I")) Is Nothing Then
    Target.Value = IIf(Not Target.Value = "þ", "þ", "o")
    Target.Offset(0, IIf(Target.Column = 8, 1, -1)).Value = IIf(Target.Value = "þ", "o", "þ")
    Cells(Target.Row, 4).Interior.ColorIndex = IIf(Cells(Target.Row, 8).Value = "þ", 4, 3)
    Cancel = True
End If
End Sub

bonne soirée
@+

 

[anthoYS]

Re : Check box automatique en double

Merci à vous tous, ça marche, surtout la dernière me convient, car en effet, les "checkbox" s'excluent mutuellement.