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
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.
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
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.
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
Bonjour François ;
Voila ma procedure Worsheet_Change, et elle ne marche pas :
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)
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
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
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
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.
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.
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.