Discussion :

[Un Internaute]

Bonjour le forum,
Lors de chaque clic dans la colonne F s'affiche: "PLAQUES", "OSTHÉOPATHIE", "PAIEMENT 5 SÉANCES", "PAIEMENT 6 SÉANCES", "PAIEMENT 7 SÉANCES", "PAIEMENT 12 SÉANCES"
Avec couleurs différentes pour: "PLAQUES", "OSTHÉOPATHIE" et même couleur pour: "PAIEMENT 5 SÉANCES", "PAIEMENT 6 SÉANCES", "PAIEMENT 7 SÉANCES", "PAIEMENT 12 SÉANCES"
Que dois-je ajouter dans la macro pour que les cellules de colonne F revienne à leur couleur d'origine après avoir "épuisé" les double clic?
Merci d'avance pour vos retours
Bonne journée à vous tous
Bien cordialement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Matthou]

Salut a toi, tu dit Si couleur(TbCoul) = 0 Alors on sécurise la couleur à l'intérieur de la colonne 0 ligne (-1 ?) tu devrais surement rédéfinir que Couleur = 0. Enfin je pense, en tout cas il y'a quelque chose qui, de base, est correct mais qui change au fur et a mesure du code.

[geogeo70]

bonsoir,

en essayant ton code, j'ai vu une remise à zero inutile... peut être ... et je remettrais les valeurs au vide pour la couleur 0 ; voici le code qui fonctionne chez moi (en deprotégeant la feuille ) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
37
38
39
40
41
42
43
44
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        à supprimer!!!
        '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

 ' ajouté par moi
          Application.EnableEvents = False 
          Target.Offset(0, -5) = ""
          Target.Offset(0, -4) = ""   
          Target.Offset(0, -5).Resize(1, 6).Interior.ColorIndex = 0
          Application.EnableEvents = True
'
          Target.Interior.ColorIndex = Couleur
        End If
        'ActiveSheet.Protect
    Else
        Target = ""
    End If
  End If
End Sub

geogeo

[Un Internaute]

Bonsoir geogeo70,
Je te remercie de ton implication.
Ce n'est pas tout à fait ça.
Je vais tenter de m'expliquer un peu mieux.
1er clic = cellule F = 15
2ème clic = cellule F = 17
3ème clic = Ligne = Rose et 0 colonne B
4ème clic = IDEM
5ème clic = IDEM
6ème clic = IDEM
7ème clic = Retour à couleur d'origine Cellule F

J'espère que c'est un peu plus clair
A+ peut-être
Bonne fin de soirée
Bien cordialement