Comment améliorer ce code [...] un double clic ça ne donne pas de couleur ? [RESOLU]

[anthoYS]

bonjour,

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)  li = Target.Row
  If Not Intersect(Target, [C:C]) Is Nothing Then
    With Range("B" & li)
      .Interior.Pattern = 0
      .Interior.ColorIndex = 4
    End With
  End If
  If Not Intersect(Target, [D: D]) Is Nothing Then
    With Range("B" & li)
      .Interior.Pattern = 0
      .Interior.ColorIndex = 6
    End With
  End If
  If Not Intersect(Target, [E:E]) Is Nothing Then
    With Range("B" & li)
      .Interior.Pattern = 0
      .Interior.ColorIndex = 3
    End With
  End If
  Cancel = True
End Sub

que ça colore en vert, jaune et rouge ok mais si on double clique ça doit annuler la couleur (aucune mef) ou alors mettre le couleur voulu.
ou alors ajouter une colonne ou ça ne donne pas de coloration F


merci
à+

 

[camarchepas]

Re : Comment améliorer ce code pour qu'en un double clic ça ne donne pas de couleur ?

Bonjour Anthony,

Comme ceci en fonction de ta version Excel

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

 With Range("B" & Target.Row)
   If Not Intersect(Target, [C:C]) Is Nothing Then
     If .Interior.Color = 16777215 Then
        .Interior.ColorIndex = 4
       Else
        .Style = "Normal"
     End If
   End If
   If Not Intersect(Target, [D:D]) Is Nothing Then
     If .Interior.Color = 16777215 Then
        .Interior.ColorIndex = 6
       Else
        .Style = "Normal"
     End If
   End If
   If Not Intersect(Target, [E:E]) Is Nothing Then
     If .Interior.Color = 16777215 Then
        .Interior.Pattern = 0
        .Interior.ColorIndex = 3
       Else
        .Style = "Normal"
     End If
   End If
 End With
Cancel = True
End Sub

 

[JCGL]

Re : Comment améliorer ce code pour qu'en un double clic ça ne donne pas de couleur ?

Bonjour à tous,
Salut Nono,

Peux-tu essayer :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, [C:C]) Is Nothing Then
        Range("B" & Target.Row).Interior.ColorIndex = IIf(Range("B" & Target.Row).Interior.ColorIndex = 4, xlNone, 4)
    End If

    If Not Intersect(Target, [D:D]) Is Nothing Then
        Range("B" & Target.Row).Interior.ColorIndex = IIf(Range("B" & Target.Row).Interior.ColorIndex = 6, xlNone, 6)
    End If

    If Not Intersect(Target, [E:E]) Is Nothing Then
        Range("B" & Target.Row).Interior.ColorIndex = IIf(Range("B" & Target.Row).Interior.ColorIndex = 3, xlNone, 3)
    End If
    Cancel = True
End Sub

A+ à tous