Option Explicit
Dim NoLignesCommentaire As Byte
Dim EnPlus As Byte
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
If Target.Column = 1 And Target.Count = 1 And IsEmpty(Target) Then Cancel = True: AjoutLigne
If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 14 And Target.Count = 1 Then Cancel = True: GetCursorPos PtCur: ufCalendrier.Show
If Target.Column = 10 And Target.Count = 1 Then
If Target = "" Then
Target = "X"
ElseIf Target = "X" Then
Target = ""
End If
Cancel = True
End If
If Target.Column = 11 And Target.Count = 1 Then
If Target = "" Then
Target = "Av": Target.Interior.ColorIndex = 7
ElseIf Target = "Av" Then
Target = "": Target.Interior.ColorIndex = -4142
End If
Cancel = True
End If
If Target.Column = 12 And Target.Count = 1 Then
If Target = "" Then
Cancel = True: GetCursorPos PtCur: ufCalendrier.Show
Target.Interior.ColorIndex = 36
Target(1, 2) = "": Target(1, 2).Interior.ColorIndex = -4142
ElseIf Target.Text Like "##-??*-##" Then
If Target.Comment Is Nothing Then Target.AddComment
EnPlus = IIf(UBound(Split(Target.Comment.Text, vbLf)) = -1, 2, 1)
NoLignesCommentaire = UBound(Split(Target.Comment.Text, vbLf)) + EnPlus
Target.Comment.Text Text:=NoLignesCommentaire & " - " & Target.Text & vbLf & Target.Comment.Text
Target = "": Target.Interior.ColorIndex = -4142
Target(1, 2) = "NP": Target(1, 2).Interior.ColorIndex = 36
End If
Cancel = True
End If
If Target.Column = 13 And Target.Count = 1 Then
If Target = "" Then
Target = "NP": Target.Interior.ColorIndex = 36
If Target(1, 0).Comment Is Nothing Then Target(1, 0).AddComment
EnPlus = IIf(UBound(Split(Target(1, 0).Comment.Text, vbLf)) = -1, 2, 1)
NoLignesCommentaire = UBound(Split(Target(1, 0).Comment.Text, vbLf)) + EnPlus
Target(1, 0).Comment.Text Text:=NoLignesCommentaire & " - " & Target(1, 0).Text & vbLf & Target(1, 0).Comment.Text
Target(1, 0) = "": Target(1, 0).Interior.ColorIndex = -4142
ElseIf Target = "NP" Then
Target = "": Target.Interior.ColorIndex = -4142
CellulePrecedente = True
GetCursorPos PtCur:
PtCur.x = PtCur.x - 50: ufCalendrier.Show
Target(1, 0).Interior.ColorIndex = 36
End If
Cancel = True
End If
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then
If Target.Value < Target(1, 0) Then _
MsgBox "La date de facture est plus récente que la date d'échéance!": _
GetCursorPos PtCur: ufCalendrier.Show
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub