Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
If IsNumeric(Mid(Target.Value, Len(Target.Value), 1)) Then
Target.Value = Mid(Target.Value, 1, Len(Target.Value) - 1) & Mid(Target.Value, Len(Target.Value), 1) + 1
Else
Target.Value = Target.Value & 1
End If
End If
If Not Application.Intersect(Target, Range("B:B")) Is Nothing And IsEmpty(Target) Then
F_calendrier1dateTableur.Show
End If
Cancel = True
If Target.Column = 4 Then
Cells(Target.Row, 4) = Date
Cells(Target.Row, 2).Interior.color = vbYellow ' jaune
End If
If Target.Column = 4 Then
Cells(Target.Row, 4) = Date
Cells(Target.Row, 2).Interior.color = vbGreen ' Vert
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 4 Then Exit Sub
If Not IsEmpty(Target) Then
Target.Offset(0, 1) = Date
Target.Offset(0, -1).Interior.color = vbYellow
Target.Offset(0, -1).Font.Bold = True
Else
Target.Offset(0, 1).ClearContents
Target.Offset(0, -1).Interior.color = xlNone
Target.Offset(0, -1).Font.Bold = False
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Column = 3 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 104.5
.Comment.Shape.Height = 110.6
.Comment.Shape.TextFrame.Characters.Font.Bold = True
End If
SendKeys "%im"
End If
End With
Cancel = True
End Sub