Excel - Tri par couleur automatique

Asked By Gabriel on 30-Dec-09 07:33 AM
Bonjour,

Je souhaite r?aliser un tableau avec Excel 2003 ou les lignes seraient
tri?es lors du changement de couleur. les lignes en noir au d?but et
les lignes en rouges ? la fin et chacune des 2 couleurs tri?es
alphab?tiquement (premi?re colone).

En faite actuellement mon tableau se tri automatiquement par ordre
alphab?tique (sur la premi?re colonne) ? chaque nouvelle ligne ajout?e.
grace ? un VBA trouv? sur l'excellent site de JB
(http://boisgontierjacques.free.fr/)

Et je souhaiterai que les lignes que je passe en rouge viennent se
mettre ? la fin du tableau mais tri?es ?galement par odre alphab?tique
(les noires en haut tri?es par ordre alphab?tique et les rouges en bas
tri?es par ordre alphab?tique)

est-ce jouable ?

Merci.

--

Cordialement,
Gabriel




Gabriel replied to Gabriel on 30-Dec-09 07:38 AM
Gabriel a ?mis l'id?e suivante :
[...]

oups, j'ai oubli? le fichier actuel :
http://www.cijoint.fr/cjlink.php?file=cj200912/cijZYCM4xq.xls

--

Cordialement,
Gabriel
FFO replied to Gabriel on 30-Dec-09 09:08 AM
Salut ?? toi

Je te propose ce code :

For Each c In Range("A3", "A" & Range("A65535").End(xlUp).Row - 1)
If c.Font.ColorIndex = -4105 Then
Range("G" & c.Row) = 1
End If
Next
Range("A3", "G" & Range("A65535").End(xlUp).Row - 1).Sort
Key1:=Range("G3"), Order1:=xlAscending
Columns("G:G").Clear


Une fois le tri alphab??tique r??alis?? tu l'ex??cutes

La colonne G est utilis??e pour marquer les cellules de la colonne A qui sont
en noir
Je suppose que c'est sur ces cellules sur lesquelles on doit se baser pour
basculer ou non les lignes en fin de liste

Cette colonne G doit donc rest??e disponibles au fonctionnement de ce code

Si tu veux utiliser une autre colonne il suffit de changer dans le code tous
les "G" par la nouvelle lettre correspondant ?? cette autre colonne (elle doit
??tre apr??s celles utilis??es par tes donn??es)

Pour la colonne H cel?? donnra :

For Each c In Range("A3", "A" & Range("A65535").End(xlUp).Row - 1)
If c.Font.ColorIndex = -4105 Then
Range("H" & c.Row) = 1
End If
Next
Range("A3", "H" & Range("A65535").End(xlUp).Row - 1).Sort
Key1:=Range("H3"), Order1:=xlAscending
Columns("H:H").Clear

Sur ce lien ton fichier adapt?? ainsi

Apr??s l'avoir r??cup??r?? ouvres le et actives le bouton "Tri Couleur"

Fais des essais et dis moi !!!!!

http://www.cijoint.fr/cjlink.php?file=cj200912/cijtgKaen7.xls
michdenis replied to Gabriel on 30-Dec-09 09:08 AM
Bonjour,

A ) Si tu modifies la couleur d'une cellule en utilisant l'i?one
affichant le tableau des couleurs, la proc?dure
n'est pas d?clench?e -> donc pas de mise ? jour
tu dois double-cliquer sur une cellule de la colonne A:A
pour provoquer la mise ? jour apr?s avoir modifi? la
couleur du texte d'une cellule.

B ) ta ligne de formule : =NBVAL(A1:A2)
Tu la places juste en dessous de ta ligne d'?tiquettes
?a te permettra d'ajouter toutes les lignes que tu veux
sans venir perturber ta proc?dure !

Dans le module feuille, tu remplaces ta proc?dure par celle-ci

Cette proc?dure de la colonne G:G, donc je suppose
qu'elle est disponible !
'------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
If Target.Column = 1 And Target.Count = 1 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
nom = Target
Set Rg = Range("G4:G" & Range("A65536").End(xlUp).Row)
Rg.NumberFormat = "General"
Rg.Formula = "=Couleur(" & Rg(1).Offset(, -6). _
Address(0, 0) & ")"
Rg.Value = Rg.Value
With Rg.Offset(, -6).Resize(, 7)
.Sort key1:=.Item(1, 7), order1:=xlAscending, _
Key2:=.Item(1, 1), Order2:=xlAscending
End With
[A:A].Find(what:=nom).Select
Rg = ""
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
'------------------------------------------
Dans un module standard, tu copies ceci :
'-------------------------------------------
Function Couleur(Rg As Range)
Couleur = Rg.Font.ColorIndex
End Function
'-------------------------------------------




Bonjour,

Je souhaite r?aliser un tableau avec Excel 2003 ou les lignes seraient
tri?es lors du changement de couleur. les lignes en noir au d?but et
les lignes en rouges ? la fin et chacune des 2 couleurs tri?es
alphab?tiquement (premi?re colone).

En faite actuellement mon tableau se tri automatiquement par ordre
alphab?tique (sur la premi?re colonne) ? chaque nouvelle ligne ajout?e.
grace ? un VBA trouv? sur l'excellent site de JB
(http://boisgontierjacques.free.fr/)

Et je souhaiterai que les lignes que je passe en rouge viennent se
mettre ? la fin du tableau mais tri?es ?galement par odre alphab?tique
(les noires en haut tri?es par ordre alphab?tique et les rouges en bas
tri?es par ordre alphab?tique)

est-ce jouable ?

Merci.

--

Cordialement,
Gabriel
michdenis replied to michdenis on 30-Dec-09 09:32 AM
Une information suppl?mentaire,

Comme dit pr?c?demment, l'usage de l'ic?ne pour modifier la couleur du texte d'une cellule
ou le fond de celle-ci ne d?clenche pas de proc?dure ?v?nementielle. Cependant, tu peux
faire ceci :

Dans une plage de cellules, ? titre d'exemple...
la ligne sous l'?tiquette des colonnes, tu ins?res
un texte quelconque dont  tu formates le texte
de ces cellules avec les couleurs que tu auras de
besoin en A:A pour ton application.

Si tu utilises l'outil "Le balai" de la barre d'outils
pour applique la couleur d'une de ces cellules de ta
plage exemple vers ta cellule de ton choix en A:A,
ceci d?clenchera la mise ? jour automatiquement.




Bonjour,

A ) Si tu modifies la couleur d'une cellule en utilisant l'i?one
affichant le tableau des couleurs, la proc?dure
n'est pas d?clench?e -> donc pas de mise ? jour
tu dois double-cliquer sur une cellule de la colonne A:A
pour provoquer la mise ? jour apr?s avoir modifi? la
couleur du texte d'une cellule.

B ) ta ligne de formule : =NBVAL(A1:A2)
Tu la places juste en dessous de ta ligne d'?tiquettes
?a te permettra d'ajouter toutes les lignes que tu veux
sans venir perturber ta proc?dure !

Dans le module feuille, tu remplaces ta proc?dure par celle-ci

Cette proc?dure de la colonne G:G, donc je suppose
qu'elle est disponible !
'------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
If Target.Column = 1 And Target.Count = 1 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
nom = Target
Set Rg = Range("G4:G" & Range("A65536").End(xlUp).Row)
Rg.NumberFormat = "General"
Rg.Formula = "=Couleur(" & Rg(1).Offset(, -6). _
Address(0, 0) & ")"
Rg.Value = Rg.Value
With Rg.Offset(, -6).Resize(, 7)
.Sort key1:=.Item(1, 7), order1:=xlAscending, _
Key2:=.Item(1, 1), Order2:=xlAscending
End With
[A:A].Find(what:=nom).Select
Rg = ""
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
'------------------------------------------
Dans un module standard, tu copies ceci :
'-------------------------------------------
Function Couleur(Rg As Range)
Couleur = Rg.Font.ColorIndex
End Function
'-------------------------------------------




Bonjour,

Je souhaite r?aliser un tableau avec Excel 2003 ou les lignes seraient
tri?es lors du changement de couleur. les lignes en noir au d?but et
les lignes en rouges ? la fin et chacune des 2 couleurs tri?es
alphab?tiquement (premi?re colone).

En faite actuellement mon tableau se tri automatiquement par ordre
alphab?tique (sur la premi?re colonne) ? chaque nouvelle ligne ajout?e.
grace ? un VBA trouv? sur l'excellent site de JB
(http://boisgontierjacques.free.fr/)

Et je souhaiterai que les lignes que je passe en rouge viennent se
mettre ? la fin du tableau mais tri?es ?galement par odre alphab?tique
(les noires en haut tri?es par ordre alphab?tique et les rouges en bas
tri?es par ordre alphab?tique)

est-ce jouable ?

Merci.

--

Cordialement,
Gabriel
Gabriel replied to FFO on 30-Dec-09 09:59 AM
FFO a pr?sent? l'?nonc? suivant :

Merci beaucoup ?a fonctionne tr?s bien mais moins automatique que la
version de michdenis qui a ma pr?f?rence vu que c'est destin? ? des
utilisateurs qui on parfois jusqu'a la fleme de cliquer sur un bouton,
?a me va tr?s bien. Cependant je garde ton exemple sous le coude ?a
pourra me servir.

Encore merci.

--

Cordialement,
Gabriel
Gabriel replied to michdenis on 30-Dec-09 10:04 AM
michdenis vient de nous annoncer :

sublissime, ?a me va parfaitement.
Un gros merci ? toi et ? FFO qui m'avez solutionn? mon probl?me, c'est
beau l'entraide, vive les newsgroups :D

--

Cordialement,
Gabriel
Gabriel replied to michdenis on 06-Jan-10 08:56 AM
Bonjour ? tous et meilleurs voeux,

http://www.cijoint.fr/cjlink.php?file=cj201001/cijXHNGF5X.xls

Suite ? ma question initiale et la r?ponse de michdenis ci-dessous, que
je remercie de nouveau au passage, j'aimerai ajouter une colonne F avec
des montants (voir fichier joint) et sur le cot? du tableau :
- en I3 et I4 avoir le nombre de lignes ?crites en noir (ou plut?t
- en J3 / J4 le montant total (PV HT) des lignes noires et le montant
total des lignes rouges.

J'ai essay? de le faire tout seul avec des VBA trouv?s sur internet
mais losrque j'appel la fonction depuis le script de michdenis (avec
boucle infini et je suis oblig? de le "killer" avec le gestionnaire de
t?ches.

De plus ce sera certainement plus propre d'ajouter ces modifications en
parall?le dans le code existant mais je ne sais pas le faire c'est
pourquoi je sollicite votre aide ? nouveau.

En plus avec l'ajout d'une colonne je suppose que le script VBA de
michdenis doit ?tre modifi?. Selon ce que je comprend je pense qu'il
faut faire les modifications suivantes mais est-ce exacte ? :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
If Target.Column = 1 And Target.Count = 1 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
nom = Target
Set Rg = Range("H4:H" & Range("A65536").End(xlUp).Row)
Rg.NumberFormat = "General"
Rg.Formula = "=Couleur(" & Rg(1).Offset(, -7). _
Address(0, 0) & ")"
Rg.Value = Rg.Value
With Rg.Offset(, -7).Resize(, 8)
.Sort key1:=.Item(1, 8), order1:=xlAscending, _
Key2:=.Item(1, 1), Order2:=xlAscending
End With
[A:A].Find(what:=nom).Select
Rg = ""
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

Merci d'avance pour votre aide pr?cieuse.
michdenis replied to Gabriel on 06-Jan-10 02:43 PM
Ton fichier en retour.
http://cjoint.com/?bguNBwhqjs

Avec des trucs bas?s sur la couleur du texte, le m?me principe
s'applique... si tu modifies le format "couleur" du texte avec
le bouton "couleur texte" de la barre d'outil, cela ne d?clenche
aucun ?v?nement et les fonctions ne sont pas calcul?es sauf si
tu appuies sur la touche F9.
dans la fonction, le premier param?tre, c'est la plage de cellules,
le deuxi?me "Cell" c'est une cellule de r?f?rence contenant le
bon format (couleur du texte) que tu veux calculer.



Bonjour ? tous et meilleurs voeux,

http://www.cijoint.fr/cjlink.php?file=cj201001/cijXHNGF5X.xls

Suite ? ma question initiale et la r?ponse de michdenis ci-dessous, que
je remercie de nouveau au passage, j'aimerai ajouter une colonne F avec
des montants (voir fichier joint) et sur le cot? du tableau :
- en I3 et I4 avoir le nombre de lignes ?crites en noir (ou plut?t
- en J3 / J4 le montant total (PV HT) des lignes noires et le montant
total des lignes rouges.

J'ai essay? de le faire tout seul avec des VBA trouv?s sur internet
mais losrque j'appel la fonction depuis le script de michdenis (avec
boucle infini et je suis oblig? de le "killer" avec le gestionnaire de
t?ches.

De plus ce sera certainement plus propre d'ajouter ces modifications en
parall?le dans le code existant mais je ne sais pas le faire c'est
pourquoi je sollicite votre aide ? nouveau.

En plus avec l'ajout d'une colonne je suppose que le script VBA de
michdenis doit ?tre modifi?. Selon ce que je comprend je pense qu'il
faut faire les modifications suivantes mais est-ce exacte ? :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
If Target.Column = 1 And Target.Count = 1 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
nom = Target
Set Rg = Range("H4:H" & Range("A65536").End(xlUp).Row)
Rg.NumberFormat = "General"
Rg.Formula = "=Couleur(" & Rg(1).Offset(, -7). _
Address(0, 0) & ")"
Rg.Value = Rg.Value
With Rg.Offset(, -7).Resize(, 8)
.Sort key1:=.Item(1, 8), order1:=xlAscending, _
Key2:=.Item(1, 1), Order2:=xlAscending
End With
[A:A].Find(what:=nom).Select
Rg = ""
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

Merci d'avance pour votre aide pr?cieuse.
Gabriel replied to michdenis on 06-Jan-10 03:48 PM
michdenis a formul? ce mercredi :
Y a rien ? dire ? part un gros merci et pour paraphraser mon pr?c?dent
message merci ?galement ? tout ceux qui donnent de leur temps sur les
forum pour aider les plus novices.

? bient?t

--
Cordialement,
Gabriel