OVH Cloud OVH Cloud

Format conditionelles

17 réponses
Avatar
Apitos
Bonsoir,

Comment puis-je avoir des couleurs selon des dates du mois avec les
formats conditionnelles ?

Merci d'avance.

7 réponses

1 2
Avatar
Apitos
Bonsoir François L :


A remplacer par
If Not IsDate(Target) Then
Range("A" & Target.Row, "F" & Target.Row).Interior.ColorIndex = 0
Exit Sub
End If


Un inconvénient :

Quand je clique sur une cellule de la colonne B, la couleur de la ligne
complete redevient blanche !!!

Pourqoi ?

François L


Salutations.

Avatar
Francois L
Bonsoir François L :


A remplacer par
If Not IsDate(Target) Then
Range("A" & Target.Row, "F" & Target.Row).Interior.ColorIndex = 0
Exit Sub
End If


Un inconvénient :

Quand je clique sur une cellule de la colonne B, la couleur de la ligne
complete redevient blanche !!!




Bonjour,

Rajouter en tout début de procédure le test suivant :

If Intersect(Range("A:A"), Target) Is Nothing Then
Exit Sub
End If

--
François L


Avatar
Apitos
Bonjour François ;

Voila ma procedure Worsheet_Change, et elle ne marche pas :

Private Sub Worksheet_Change(ByVal Target As Range)

'Traduit en Nompropre dès la saisie dans la colonne B et C
Application.EnableEvents = False
'importation des données au formay texte
'Cells.NumberFormat = "@"
If Target.Column = 2 And Target.Count = 1 Then
Target = Application.Proper(Target)
End If
If Target.Column = 3 And Target.Count = 1 Then
Target = Application.Proper(Target)
End If
'--- Extraction de désignation sans doublons
If Target.Column = 2 And Target.Count = 1 Then
[B1:B1000].AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Feuil2").Range("A1"), Unique:=True
Sheets("feuil2").Range("a2:a1000").Sort
key1:=Sheets("feuil2").Range("a2")
End If
'--- Extraction de catégorie sans doublons
If Target.Column = 3 And Target.Count = 1 Then
[C1:C1000].AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Feuil2").Range("D1"), Unique:=True
Sheets("feuil2").Range("d2:d1000").Sort
key1:=Sheets("feuil2").Range("D2")
Application.EnableEvents = True
End If
'--- tri dyn
If Target.Column >= 1 And Target.Column <= 6 And Target.Count = 1
Then
témoin = True
ligne = Target.Row
End If
' --- 7 jours 7 couleurs
' si on est sur une ligne x ou Ax ne contient pas une date alors la
couleur est blanche
If Intersect(Range("A:A"), Target) Is Nothing Then
Exit Sub
End If
If Not IsDate(Target) Then
Range("A" & Target.Row, "F" & Target.Row).Interior.ColorIndex = 0
Exit Sub
End If
With Range("A" & Target.Row, "F" & Target.Row).Interior
Select Case Weekday(Target.Value)
Case Is = 1
.ColorIndex = 27
Case Is = 2
.ColorIndex = 45
Case Is = 3
.ColorIndex = 33
Case Is = 4
.ColorIndex = 40 '17 '15 '
Case Is = 5
.ColorIndex = 19
Case Is = 6
.ColorIndex = 44
Case Is = 7
.ColorIndex = 35 '22

End Select
End With
Application.EnableEvents = True
End Sub

Des corrections stp ?

Merci.
Avatar
Francois L
Bonjour François ;

Voila ma procedure Worsheet_Change, et elle ne marche pas :

(...)


Re,

Et elle bloque sur quelle ligne cette procédure ?

--
François L

Avatar
Apitos

Bonjour François ;

Voila ma procedure Worsheet_Change, et elle ne marche pas :

(...)


Re,

Et elle bloque sur quelle ligne cette procédure ?

--
François L


Salut François,

Toutes les taches décrites dans la procédure ne s'exécutent plus
....

(Tri dynamique, mise en majuscule, extraction de données, coloriage)


Avatar
Francois L

Bonjour François ;





Bonsoir,

J'ai fait du ménage minimum, on pourrait(devrait) faire nettement mieux.

J'ai regroupé les If Then pour limiter le nombre de test et surtout
remis de l'ordre dans EnableEvents. Mis à faux en début de procédure,
donc à chaque saisie dans la feuille, il n'étaient pas forcement
réactivés compte tenu des Exit Sub.

Normalement, comme suit ça marche mais il faudrait braiment reprendre
tout cela... on ne peut pas coller comme ça des procédures les unes
après les autres, surtout quand elles sont d'écriture hétérogène et
comportent des instructions conditionnelles. En plus dans des procédures
événementielles, il faudrait, a mon avis, toujours tester s'il y a lieu
de l'exécuter avant toute autre instruction.

Je pense que tu ferais bien de suivre les conseils qui t'ont été donnés
sur un autre fil. Tu sais VBA demande un peu de réflexion et de notion
sur ce qui se passe derrière une macro, notamment avec des boucles.
Alors, consultes les sites conseillés, achètes des bouquins, fais des
exemples simples et testes les avec différentes hypothèses, apprend à
utiliser l'enregistreur de macro et à nettoyer le code qu'il produit, etc.

Attention, dans ce qui suit, j'ai viré un bout de procédure dont je ne
sais pas à quoi il sert :
If Target.Column >= 1 And Target.Column <= 6 And Target.Count = 1
Then
témoin = True
ligne = Target.Row
End If

Ce qui devrait fonctionner :

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Target.Column = 2 And Target.Count = 1 Then
Target = Application.Proper(Target)
[B1:B1000].AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Feuil2").Range("A1"), Unique:=True
Sheets("feuil2").Range("a2:a1000").Sort _
key1:=Sheets("feuil2").Range("a2")
End If

If Target.Column = 3 And Target.Count = 1 Then
Target = Application.Proper(Target)
[C1:C1000].AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Feuil2").Range("D1"), Unique:=True
Sheets("feuil2").Range("d2:d1000").Sort _
key1:=Sheets("feuil2").Range("D2")
End If

If Intersect(Range("A:A"), Target) Is Nothing Then
Application.EnableEvents = True
Exit Sub
End If

If Not IsDate(Target) Then
Range("A" & Target.Row, "F" & Target.Row).Interior.ColorIndex = 0
Application.EnableEvents = True
Exit Sub
End If
With Range("A" & Target.Row, "F" & Target.Row).Interior
Select Case Weekday(Target.Value)
Case Is = 1
.ColorIndex = 27
Case Is = 2
.ColorIndex = 45
Case Is = 3
.ColorIndex = 33
Case Is = 4
.ColorIndex = 40 '17 '15 '
Case Is = 5
.ColorIndex = 19
Case Is = 6
.ColorIndex = 44
Case Is = 7
.ColorIndex = 35 '22
End Select
End With
Application.EnableEvents = True
End Sub



Avatar
Apitos
C'est très gentil de ta pars François.

Voila le type de gens que j'aimes et je suis toujours prés, avec
grande joie, à leurs bien écouter et par conséquent bien apprendre.

Au moins ils te donnent une piste ou une solution, et avec, ils te
filent de bons conseils avec des dires plus civilisés, parce que la
vie est ainsi faite, on fait toujours des erreurs - intentionnelles
- et on est jamais meilleur à 100 %.

Je le reconnais, et je l'ai toujours reconnu (Même pour les autres
langages de programmation que je l'ai apprise de tels gens
(Delphi+PHP)), je suis toujours au début de mes savoirs même si je
fais de la programmation à titre personnel depuis 20 ans.

Merci pour de tels gens et je leurs tire chapeau.

Salutations.
1 2