Discussion :

[janigrel]

Au top, Keygen08, comme d'hab ! !

Je pense être arrivé à qq chose de pas mal grâce à vous (et dire que je n'avais jamais entendu parler de macro il y a 2 mois...). Je vais vraiment m'y mettre, il n'y a pas de quoi s'en priver...
Encore merci pour tout, ce doit être un vrai bonheur de bosser avec vous.

Cordialement.

C'est encore moi.
Désolé, Kengen08, mais après quelques tests, dans ton dernier code, quand par exemple on se trompe de valeur n'importe où dans une ligne, et qu'on l'annule, toute la ligne se colore alors en bleu.
Il en est de même si je double clique n'importe où dans une ligne vierge sans écrire de valeur...
Peut-on corriger cet écueil ?
Cdt.

[janigrel]

Euréka ! !

A force de persévérance, j'arrive enfin à ce que je cherchais, en ayant seulement rajouter en fin de code :

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
.....
            If Cells(r, c) = "RDV" Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 4 'vert
            Exit Sub
            Else
 
            For c = 46 To 106 Step 5
                If Cells(r, c) <> "" Then
                Range("a" & r & ":dd" & r).Interior.ColorIndex = 37 'bleu
                Exit For
                End If
            Next c
 
            End If
        End If
End If
 
End Sub

Merci encore
Cdt.

[janigrel]

Bonjour Keygen08,

Le code que vous m'avez permis de mettre au point pour mes couleurs de lignes, fonctionne à merveille, sauf que, depuis...
...certains prospects n'ont pas droit à l'offre "FEF + CMT" des colonnes 45 (AS) à 105 (DA) step 5. Donc pour ces prospects-là qui répondent à 2 critères, j'ai créé un code pour aller inscrire la valeur "NON" dans les colonnes 45 à 105 step 5, comme vous pourrez vous en rendre compte dans un extrait-image de mon tableau en pièce jointe.
Or, comme des valeurs "NON" sont inscrites jusqu'au bout du tableau, vous comprendrez que le code couleur ne fonctionne pas : par exemple en ligne 5, le RDV pris ne colore pas la ligne en vert comme ça devrait être le cas, car des valeurs "NON" inscrites après laissent la ligne en blanc. Il en est de même à la ligne 6, où le "REFUS CAT" devrait colorer toute la ligne en rouge.

Pour rappel, voici le code définitif que j'ai retenu pour les couleurs :

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
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer, c As Integer
Dim ArrWd
'pour commencer en ligne 3
If Target.Row >= 3 And Target.Row <= 2000 Then
 Range("a" & Target.Row & ":dd" & Target.Row).Interior.ColorIndex = -4142 'couleur automatique
 r = Target.Row
 c = Cells(r, 250).End(xlToLeft).Column
 ArrWd = Split("REFUS CAT, CLIENT/PROSPECT INTERNE, SANS AUTO", ", ")
    For i = 0 To UBound(ArrWd)
            If Cells(r, c) = ArrWd(i) Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 3 'rouge
            Exit Sub
            End If
    Next i
        If Cells(r, c) = "OUI" Then
        Range("a" & r & ":dd" & r).Interior.ColorIndex = 40 'orange
        Exit Sub
        Else
            If Cells(r, c) = "RDV" Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 4 'vert
            Exit Sub
            Else
 
            For c = 46 To 106 Step 5
                If Cells(r, c) <> "" Then
                Range("a" & r & ":dd" & r).Interior.ColorIndex = 40 'orange
                Exit For
                End If
            Next c
 
            End If
        End If
End If
 
End Sub

Pensez-vous pouvoir m'aider pour prendre en compte cette modification et adapter le code couleur?
Ou alors, j'ai pensé la solution qui consisterait à adapter le code qui vient exclure les prospects : au lieu d'inscrire "NON" dans les colonnes concernées, y a t-il par exemple possibilité de bloquer toute saisie dans les cellules concernées (avec ou sans Messagebox quand quelqu'un souhaiterait saisir "OUI"...???), ce qui éviterait d'écrire la valeur "NON" et permettrait au code-couleur de fonctionner.

Je vous remercie de vos éclairages. Si besoin, voici mon code qui exclut certains prospects :

Code :

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

1
2
3
4
5
6
7
8
9
10
Dim rng As Range, i As Integer, SpecCell As Range
Set SpecCell = Range("K3:K2000").SpecialCells(xlCellTypeConstants) 
Application.ScreenUpdating = False 'Arrête la mise à jour de l'affichage sur écran jusqu'à la fin de la routine
For i = 45 To 105 Step 5
For Each rng In SpecCell.Cells
If rng.Value = "GR" Or rng.Value = "GE" Then
Cells(rng.Row, i).Value = "NON"
End If
Next
Next

[keygen08]

Bonjour

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
 
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer, c As Integer
Dim ArrWd
If Target.Row >= 3 And Target.Row <= 2000 Then
 Range("a" & Target.Row & ":dd" & Target.Row).Interior.ColorIndex = -4142 'couleur automatique
 r = Target.Row
 c = Cells(r, 250).End(xlToLeft).Column
 ArrWd = Split("REFUS CAT, CLIENT/PROSPECT INTERNE, SANS AUTO", ", ")
    For i = 0 To UBound(ArrWd)
            If Cells(r, c) = ArrWd(i) Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 3 'rouge
            Exit Sub
            End If
    Next i
'on peut ajouter 2 conditions avant de peindre en orange, il faut que la cellule K de la ligne concernée
'ne contiennent ni GE ni GR, ainsi meme si la valeur de cellule est oui, la ligne n'est pas orange.
        If Cells(r, c) = "OUI" And Cells(r, 11) <> "GR" And Cells(r, 11) <> "GE" Then
        Range("a" & r & ":dd" & r).Interior.ColorIndex = 40 'orange
        Exit Sub
        Else
            If Cells(r, c) = "RDV" Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 4 'vert
            Exit Sub
            Else
'Pour le bleu j'applique plutot cette methode qui évite de boucler sur toutes les cellules, perte de temps
'puisque l 'on ne veut tester qu'une cellule dont la valeur de colonne finit par 1 ou 6
            If c Like "*1" Or c Like "*6" Then
                If Cells(r, c) <> "" Then
                Range("a" & r & ":dd" & r).Interior.ColorIndex = 37 'bleu
'40 etant orange, j'ai laissé en 37, bleu
                Exit Sub
                End If
            End If
        End If
End If
End Sub

quelque idée au choix ou compiler dans un meme code, le test restant si K <> GE ou GR
je dit colonne colonne 45 mais cela concerne evidement de 45 a 105 step 5
- sur selection de colonne 45...msgbox "Vous ne devez pas ecrire dans cette cellule"
- effacer tous ce qui est ecrit dans colonne 45.... (c'est rigolo et ressemble a un gros bug pour l'utilisateur).
- proteger en ecriture ces cellules mais cela oblige a proteger la feuille, avec ou sans mot de passe
- selectionner automatiquement la cellule a coté si colonne 45.... est selectionner
- ne pas autoriser la selection de colonne 45.... (fonction scrollarea de la feuille)
- peindre en noir colonne 45...
Vous me dites, je code ou vous dit comment coder, et voila un homme heureux.

[janigrel]

Bonjour,

Merci pour votre réponse.
Parmi les solutions, tant qu'à faire, je préfère ne pas inscrire les valeurs "NON" dans les cellules de 45 à 105 step 5, ne pas modifier le code pour les couleurs, et retenir la solution de peindre en noir chaque cellule concernée de la colonne 45 à 105 step 5, ce qui équivaut à empêcher la saisie.
Aussi, si vous pouvez m'aider à rédiger : "dans les colonnes 45 à 105 step 5, quand la valeur GR ou GE est présente dans la ligne à la colonne K, alors peindre les cellules 45 à 105 step 5 en noir.
Je serais intéressé, pour ma culture VBA, de connaître la syntaxe de la fonction ScrollArea.

Merci d'avance.

[keygen08]

voili, voilu

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
45
46
47
48
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer, c As Integer
Dim ArrWd
If Target.Row >= 3 And Target.Row <= 2000 Then
 Range("a" & Target.Row & ":dd" & Target.Row).Interior.ColorIndex = -4142 'couleur automatique
 r = Target.Row
 c = Cells(r, 250).End(xlToLeft).Column
 ArrWd = Split("REFUS CAT, CLIENT/PROSPECT INTERNE, SANS AUTO", ", ")
    For i = 0 To UBound(ArrWd)
            If Cells(r, c) = ArrWd(i) Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 3 'rouge
            Exit Sub
            End If
    Next i
 
        If Cells(r, c) = "OUI" And Cells(r, 11) <> "GR" And Cells(r, 11) <> "GE" Then
        Range("a" & r & ":dd" & r).Interior.ColorIndex = 40 'orange
        Exit Sub
        Else
            If Cells(r, c) = "RDV" Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 4 'vert
            Exit Sub
            Else
 
            If c Like "*1" Or c Like "*6" Then
                If Cells(r, c) <> "" Then
                Range("a" & r & ":dd" & r).Interior.ColorIndex = 37 'bleu
                Exit Sub
                End If
            End If
        End If
    End If
' pour mettre les cellule en noir si GE ou GR est saisi en colonne K
    If Cells(r, 11) = "GE" Or Cells(r, 11) = "GR" Then
            For i = 45 To 105 Step 5
            Cells(r, i).Interior.ColorIndex = 1 'noir
            Next i
        Else 'si GE ou GR est retiré de la colonne K
            For i = 45 To 105 Step 5
            Cells(r, i).Interior.ColorIndex = -4142
            Next i
    End If
 
End If
 
End Sub

[janigrel]

Bonjour,
C'est OK. Merci pour tout.