1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
| Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim N As Integer, Couleur As Integer, Indice As Integer
Dim X As String
Dim Tb, TbCoul
Application.ScreenUpdating = False
If Not Intersect(Range("F10:F104"), Target) Is Nothing Then
Cancel = True
TbCoul = Array(0, 15, 17, 3, 3, 3, 3) 'Toujours laisser le 0 en premier
Tb = Array("", "PLAQUES", "OSTHÉOPATHIE", "PAIEMENT 5 SÉANCES", "PAIEMENT 6 SÉANCES", "PAIEMENT 7 SÉANCES", "PAIEMENT 12 SÉANCES")
X = UCase(Trim(Target))
If UBound(Filter(Tb, X)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Target = Tb(Indice)
Couleur = TbCoul(Indice)
If Couleur = 0 Then
Couleur = Target.Offset(0, -1).Interior.ColorIndex
End If
ActiveSheet.Unprotect
If Left(Target, 8) = "PAIEMENT" Then
Application.EnableEvents = False
Target.Offset(0, -5) = Date
Target.Offset(0, -4) = 0 'Pour Afficher le Zéro colonne B si PAIEMENT colonne F
Target.Offset(0, -5).Resize(1, 6).Interior.ColorIndex = 26
Application.EnableEvents = True
Else
Target.Interior.ColorIndex = Couleur
End If
ActiveSheet.Protect
Else
Target = ""
End If
End If
End Sub |
Partager