XL 2013 changement de couleur avec 3 Clics

[ibni]

Bonjour à tous,
dans le fichier ci-joint j'ai un tableau échéancier,
ce que je souhaite faire c'est quand je clique 3 fois sur n'importe quelle cellule de la colonne C a partir de C15 si C15 n'est pas vide c'est à dire remplis avec texte, j'aurais la couleur orange de la même manière que C15

Cordialement

 

[Lone-wolf]

Bonjour ibni et bonne année

Tu peux me dire quel est l'interêt de cliquer 3 fois dans la cellule??? Un double-clic par évenement n'est pas suffisant?

 

[ibni]

bonjour Lone-Wolf
merci pour votre réponse, même un double clic est suffisant mais dans le cas ou j'ai envie de modifier le texte d'une cellule comment je ferai puisque le double click va colorer la ligne ??

 

[Lone-wolf]

Re

C'est quoi que tu veux colorier au juste, une cellule ou une ligne???

 

[ibni]

je ne veux pas colorier toute la ligne mais les cellules de la colonne B : K comme dans la ligne 15 dans l'exemple que j'ai joint

 

[laetitia90]

bonjour ibni ,Lone

brut comme cela il faudra traiter pour pour revenir a xlnone eventuellement

Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As Boolean)
If Not Intersect(T, [c15:c39]) Is Nothing And T.Count = 1 Then _
Cells(T.Row, 2).Resize(, 10).Interior.ColorIndex = 45
End Sub

 

[ibni]

Bonjour laetitia90,
merci beaucoup pour le code, maintenant si je veux enlever la couleur ca peut se faire avec un autre double click ??
comme ça le 1er double clic colorie la ligne et le 2ème efface la couleur ?

Cordialement

 

[Lone-wolf]

Bonjour laetitia et bonne année

Bein moi j'ai fait comme ceci. Et chose bizarre: je récupère l'index de la couleur (48 en l'occurence) et quand je double-clique la couleur est gris foncé??? Pareil avec 45.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("c15:c65536")) Is Nothing Then

For col = 2 To 9
If Target <> "" Then
Cells(ActiveCell.Row, col).Interior.Color = Range("w1").Interior.Color
Else
Cells(ActiveCell.Row, col).Interior.ColorIndex = xlNone
End If
Next col
Else
Exit Sub
End If
Cancel = True
End Sub

 

[laetitia90]

re
oui toujours avec double clik sans simplifier!!!

Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As Boolean)
If Not Intersect(T, [c15:c39]) Is Nothing And T.Count = 1 Then
If Cells(T.Row, 2).Resize(, 10).Interior.ColorIndex = 45 Then
Cells(T.Row, 2).Resize(, 10).Interior.ColorIndex = xlNone
Else
Cells(T.Row, 2).Resize(, 10).Interior.ColorIndex = 45
End If: End If
End Sub

 

[laetitia90]

re
Lone j'avais pas vu ton dernier code.... bizarre comme tu l'ecris a analyser regarderais ce soir si un peu de temps

bien sur une trés bonne année a vous 2

 

[ibni]

re,
leatitia90 votre 2ème code ne fonctionne pas quand je clique une 2ème fois pour effacer la couleur je ne sais pas pourquoi

 

[Lone-wolf]

Re laetitia, ibni

ibni, une petite correction à faire sur cette ligne : Cells(T.Row, 2).Resize(, 10). Il faut mettre 8 au lieu de 10. En Normal, la colonne I = 9, mais comme ici c'est un Resize qui correspond à Offset, il faut décaler de 2 sinon la ligne vas se colorer jusqu' à la colonne L.

EDIT: regarde avec celui-ci, si ça joue. Copie la couleur en W1 et ensuite:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("c15:c65536")) Is Nothing Then

For col = 2 To 9
If Cells(ActiveCell.Row, col).Interior.Color = Range("w1").Interior.Color Then
Cells(ActiveCell.Row, col).Interior.ColorIndex = xlNone
Else
Cells(ActiveCell.Row, col).Interior.Color = Range("w1").Interior.Color
End If
Next col
Else
Exit Sub
End If
Cancel = True
End Sub

 

[Paf]

bonjour ibni, Lone wolf, laetitia90,

la même chose avec le clic droit (il y a moins de clics à faire !):

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C15:C" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing And Target.Count = 1 Then
    With Range(Cells(Target.Row, 2), Cells(Target.Row, 9)).Interior
    .ColorIndex = IIf(.ColorIndex = xlNone, 40, xlNone)
    End With
    Cancel = True
End If
End Sub

peut-être faudra-t-il adapter le colorindex. chez moi c'est 40, mais a priori pas vrai partout.

A+

 

[laetitia90]

re ben !!! pas de pb.. chez moi je refais un double clik ca marche
Paf en general je prefere garder le clic droit pour modif cell a mon avis plus simple
autrement tu peus rajouter en fin de code avant end sub
T.Offset(, -1).Select

non lone je decale deja T.Row, 2

 

[ibni]

re,
lone wolf votre code ne fonctionne pas chez moi ça reste blanc
bonjour Paf, le votre ne fonctionne pas aussi chez moi