Modifier ce code afin qu'un deuxième double clic en B ... [résolu]

anthoYS

XLDnaute Barbatruc
... efface la date et la coloration que provoque un premier double clic (en B) ?

Bonjour,

voilà je me suis expliqué, voici le code...

VB:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Column = 2 Then
Cells(Target.Row, 3) = Date
Cells(Target.Row, 1).Interior.ColorIndex = 4
End If
End Sub

Merci bien par avance
à+
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Modifier ce code afin qu'un deuxième double clic en B ...

Bonsoir anthoYS,

Ce code peut-être?:
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Column = 2 Then
  If Cells(Target.Row, 1).Interior.ColorIndex = 4 Then
    Cells(Target.Row, 3).ClearContents
    Cells(Target.Row, 1).Interior.ColorIndex = xlColorIndexNone
  Else
    Cells(Target.Row, 3) = Date
    Cells(Target.Row, 1).Interior.ColorIndex = 4
  End If
End If
End Sub
 

anthoYS

XLDnaute Barbatruc
Re : Modifier ce code afin qu'un deuxième double clic en B ...

Bonsoir anthoYS,

Ce code peut-être?:
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Column = 2 Then
  If Cells(Target.Row, 1).Interior.ColorIndex = 4 Then
    Cells(Target.Row, 3).ClearContents
    Cells(Target.Row, 1).Interior.ColorIndex = xlColorIndexNone
  Else
    Cells(Target.Row, 3) = Date
    Cells(Target.Row, 1).Interior.ColorIndex = 4
  End If
End If
End Sub

ok merci beaucoup c'est bien ça.
 

Lone-wolf

XLDnaute Barbatruc
Re : Modifier ce code afin qu'un deuxième double clic en B ... [résolu]

Bonjour mapomme :)

Moi j'ai pensé à faire comme ceci


Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Columns("B:B")) Is Nothing Then
If ActiveCell.Offset(0, -1).Interior.Color = vbGreen Then
ActiveCell.Offset(0, -1).Interior.Color = xlNone
End If
End If
Cancel = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Columns("B:B")) Is Nothing Then
ActiveCell.Offset(0, 1) = Date
ActiveCell.Offset(0, -1).Interior.Color = vbGreen
End If
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 740
Messages
2 082 049
Membres
101 882
dernier inscrit
XaK_