XL 2013 changement de couleur avec 3 Clics

ibni

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

Pièces jointes

  • Echeancier.xlsx
    16.2 KB · Affichages: 50
Dernière édition:

laetitia90

XLDnaute Barbatruc
bonjour ibni ,Lone:):)

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

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

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

XLDnaute Barbatruc
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é??? :rolleyes: Pareil avec 45.

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

XLDnaute Barbatruc
re :)
oui toujours avec double clik sans simplifier!!!
VB:
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
 

Lone-wolf

XLDnaute Barbatruc
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:

VB:
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
 
Dernière édition:

Paf

XLDnaute Barbatruc
bonjour ibni, Lone wolf, laetitia90,

la même chose avec le clic droit (il y a moins de clics à faire !):
VB:
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

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

Discussions similaires

Réponses
17
Affichages
822

Statistiques des forums

Discussions
312 922
Messages
2 093 659
Membres
105 779
dernier inscrit
le routier