case à cocher qui rend possible l'écriture dans une plage

par **Nad-Dan** » 20 Août 2009, 21:35

re,

Au lieu du 0, si une date est présente dans la colonne avant, on pourrait mettre une mention "A renouveller" non ?

Dan

par **silvia** » 20 Août 2009, 21:53

donc si je comprends bien

si pas de date et 0, rien ne se passe
si date et 0, la cellule se renomme et se met en rouge?

Par contre si j'essaie le système 1 seul tableau par onglet, puis ajout saut et horse-ball si besoin, ça fonctionne bien, mais il me manque la macro pour copier coller tableau dans la bonne case.

http://www.cijoint.fr/cjlink.php?file=c ... xisn61.xls

Qu'en penses-tu?

par **Nad-Dan** » 20 Août 2009, 23:28

re,

si pas de date et 0, rien ne se passe
si date et 0, la cellule se renomme et se met en rouge?

Oui exact.
Si tu es d'accord je peux modifier le code en fonction.

Pour ton tableau, c'est moins clair à mon avis et tu devras parfois faire trois feuilles / client. Cela va être trop lourd à mon avis.

Amicalement

Dan

par **silvia** » 21 Août 2009, 07:45

oui alors si c'est faisable on y va comme ça!

(pour mon tableau, je pensais pas faire 3 feuilles client mais coller sous le tableau de base les autres, mais c'est vrai que c'est lourd)

merci encore pour tout!!

par **Nad-Dan** » 21 Août 2009, 12:34

re,

Remplace ton code COULEUR par celui-ci

Code: Tout sélectionner: Sub couleur() 'Macro Dan pour Silvia le 21/08/09 'http://forum.excel-pratique.com/viewtopic.php?t=12800 Dim cel As Range Application.ScreenUpdating = False Sheets("Récapitulatif").Activate For Each cel In Sheets("Récapitulatif").Range("A5:A" & Range("A65536").End(xlUp).Row) With cel .Offset(0, 2) = Sheets(cel.Value).Range("L13") If Sheets(cel.Value).Range("M13") = 0 And Val(Sheets(cel.Value).Range("L13")) > 0 Then .Offset(0, 3) = "A renouveller ?" Union(.Offset(0, 0), .Offset(0, 3)).Interior.ColorIndex = 3 ElseIf Sheets(cel.Value).Range("M13") = 0 And Val(Sheets(cel.Value).Range("L13")) = 0 Then .Offset(0, 3) = "" Union(.Offset(0, 0), .Offset(0, 3)).Interior.ColorIndex = 0 Else: .Offset(0, 3) = Sheets(cel.Value).Range("M13") If .Offset(0, 3) <= 2 And (.Offset(0, 3) > 0) Then Union(.Offset(0, 0), .Offset(0, 3)).Interior.ColorIndex = 3 Else: .Offset(0, 3).Interior.ColorIndex = 0 End If End If .Offset(0, 5) = Sheets(cel.Value).Range("L28") If Sheets(cel.Value).Range("M28") = 0 And Val(Sheets(cel.Value).Range("L28")) > 0 Then .Offset(0, 6) = "A renouveller ?" Union(.Offset(0, 0), .Offset(0, 6)).Interior.ColorIndex = 3 ElseIf Sheets(cel.Value).Range("M28") = 0 And Val(Sheets(cel.Value).Range("L28")) = 0 Then .Offset(0, 6) = "" Union(.Offset(0, 0), .Offset(0, 6)).Interior.ColorIndex = 0 Else: .Offset(0, 6) = Sheets(cel.Value).Range("M28") If .Offset(0, 6) <= 2 And (.Offset(0, 6) > 0) Then Union(.Offset(0, 0), .Offset(0, 6)).Interior.ColorIndex = 3 ElseIf .Offset(0, 3).Interior.ColorIndex = 3 Then .Offset(0, 6).Interior.ColorIndex = 0 Else: Union(.Offset(0, 0), .Offset(0, 6)).Interior.ColorIndex = 0 End If End If .Offset(0, 8) = Sheets(cel.Value).Range("L43") If Sheets(cel.Value).Range("M43") = 0 And Val(Sheets(cel.Value).Range("L43")) > 0 Then .Offset(0, 9) = "A renouveller ?" Union(.Offset(0, 0), .Offset(0, 9)).Interior.ColorIndex = 3 ElseIf Sheets(cel.Value).Range("M43") = 0 And Val(Sheets(cel.Value).Range("L43")) = 0 Then .Offset(0, 9) = "" Union(.Offset(0, 0), .Offset(0, 6)).Interior.ColorIndex = 0 Else: .Offset(0, 9) = Sheets(cel.Value).Range("M43") If .Offset(0, 9) <= 2 And (.Offset(0, 9) > 0) Then Union(.Offset(0, 0), .Offset(0, 9)).Interior.ColorIndex = 3 ElseIf .Offset(0, 3).Interior.ColorIndex = 3 Or .Offset(0, 6).Interior.ColorIndex = 3 Then .Offset(0, 9).Interior.ColorIndex = 0 Else: Union(.Offset(0, 0), .Offset(0, 9)).Interior.ColorIndex = 0 End If End If End With Next cel End Sub

Pour tes boutons, essaie de les faire par la barre d'outils "Formulaire" plutôt que par la barre d'outils "boite à outils de contrôle". Ton fichier sera ainsi autant utilisable sous windows que sous MAC OS.

Dan

par **silvia** » 21 Août 2009, 16:35

C'est super!!

petit bémol, la macro "case à cocher ne fonctionne plus ??? mais pas trop important pour l'instant!

Pour les boutons, je comprends pas trop... je les ai copier depuis un autre modèle. Mais il me semble que si je fais avec "controle formulaire" (ou Contrôle activeX) (je connais pas la différence) et bien je peux pas les mettre en couleur, c'est exact?

http://www.cijoint.fr/cjlink.php?file=c ... qAbSFv.xls

Merci pour tout en tout cas! Pas encore totalement fini mais je peux rentrer les clients dans mon fichier ce week-end avant la rentrée scolaire!

Merci encore!!

je viens de commencer à entrer les infos, et il y a un petit bug au niveau du code couleur: ça fonctionne bien si il y a un abo dressage, par contre si on met abo saut et qu'il n'y a pas d'abo dressage, le code couleur "rouge " ne fonctionne pas.... une idée de pourquoi? et la cellule en A était aussi censée se mettre en rouge et ça ne le fait plus??

Merci!
Silvia

par **silvia** » 22 Août 2009, 11:13

après plusieurs tests ... j'ai un peu modifié le code de Dan:

Code: Tout sélectionner: Sub couleur() 'Macro Dan pour Silvia le 21/08/09 'http://forum.excel-pratique.com/viewtopic.php?t=12800 Dim cel As Range Application.ScreenUpdating = False Sheets("Récapitulatif").Activate For Each cel In Sheets("Récapitulatif").Range("A5:A" & Range("A65536").End(xlUp).Row) With cel .Offset(0, 2) = Sheets(cel.Value).Range("L13") If Sheets(cel.Value).Range("M13") = 0 And Val(Sheets(cel.Value).Range("L13")) > 0 Then .Offset(0, 3) = "A renouveller ?" .Offset(0, 3).Interior.ColorIndex = 3 ElseIf Sheets(cel.Value).Range("M13") = 0 And Val(Sheets(cel.Value).Range("L13")) = 0 Then .Offset(0, 3) = "" .Offset(0, 3).Interior.ColorIndex = 0 Else: .Offset(0, 3) = Sheets(cel.Value).Range("M13") If .Offset(0, 3) <= 2 Then .Offset(0, 3).Interior.ColorIndex = 3 Else: .Offset(0, 3).Interior.ColorIndex = 0 End If End If .Offset(0, 5) = Sheets(cel.Value).Range("L28") If Sheets(cel.Value).Range("M28") = 0 And Val(Sheets(cel.Value).Range("L28")) > 0 Then .Offset(0, 6) = "A renouveller ?" .Offset(0, 6).Interior.ColorIndex = 3 ElseIf Sheets(cel.Value).Range("M28") = 0 And Val(Sheets(cel.Value).Range("L28")) = 0 Then .Offset(0, 6) = "" .Offset(0, 6).Interior.ColorIndex = 0 Else: .Offset(0, 6) = Sheets(cel.Value).Range("M28") If .Offset(0, 6) <= 2 Then .Offset(0, 6).Interior.ColorIndex = 3 Else: .Offset(0, 6).Interior.ColorIndex = 0 End If End If .Offset(0, 8) = Sheets(cel.Value).Range("L43") If Sheets(cel.Value).Range("M43") = 0 And Val(Sheets(cel.Value).Range("L43")) > 0 Then .Offset(0, 9) = "A renouveller ?" .Offset(0, 9).Interior.ColorIndex = 3 ElseIf Sheets(cel.Value).Range("M43") = 0 And Val(Sheets(cel.Value).Range("L43")) = 0 Then .Offset(0, 9) = "" .Offset(0, 9).Interior.ColorIndex = 0 Else: .Offset(0, 9) = Sheets(cel.Value).Range("M43") If .Offset(0, 9) <= 2 Then .Offset(0, 9).Interior.ColorIndex = 3 Else: .Offset(0, 9).Interior.ColorIndex = 0 End If End If If .Offset(0, 3).Interior.ColorIndex = 3 Or .Offset(0, 6).Interior.ColorIndex = 3 Or .Offset(0, 9).Interior.ColorIndex = 3 Then .Offset(0, 0).Interior.ColorIndex = 3 Else: .Offset(0, 0).Interior.ColorIndex = 0 End If End With Next cel End Sub

et maintenant ça joue mais faut pas me demander pourquoi...

A bientôt!!!!
Silvia

par **Nad-Dan** » 22 Août 2009, 12:11

re,

essaie ceci :

Code: Tout sélectionner: Sub couleur() 'Macro Dan pour Silvia le 22/08/09 'http://forum.excel-pratique.com/viewtopic.php?t=12800 Dim cel As Range Application.ScreenUpdating = False With Sheets("Récapitulatif") .Activate .Range("A6:J" & Range("A65536").End(xlUp).Row).Interior.ColorIndex = 0 For Each cel In .Range("A5:A" & Range("A65536").End(xlUp).Row) With cel 'Abo dressage .Offset(0, 2) = Sheets(cel.Value).Range("L13") If Val(Sheets(cel.Value).Range("L13")) > 0 And Sheets(cel.Value).Range("M13") = 0 Then .Offset(0, 3) = "A renouveller ?" Union(.Offset(0, 0), .Offset(0, 3)).Interior.ColorIndex = 3 ElseIf Val(Sheets(cel.Value).Range("L13")) = 0 And Sheets(cel.Value).Range("M13") = 0 Then .Offset(0, 3) = "" Else: .Offset(0, 3) = Sheets(cel.Value).Range("M13") If .Offset(0, 3) <= 2 And .Offset(0, 3) > 0 Then Union(.Offset(0, 0), .Offset(0, 3)).Interior.ColorIndex = 3 End If End If 'Abo Saut .Offset(0, 5) = Sheets(cel.Value).Range("L28") If Val(Sheets(cel.Value).Range("L28")) > 0 And Sheets(cel.Value).Range("M28") = 0 Then .Offset(0, 6) = "A renouveller ?" Union(.Offset(0, 0), .Offset(0, 6)).Interior.ColorIndex = 3 ElseIf Val(Sheets(cel.Value).Range("L28")) = 0 And Sheets(cel.Value).Range("M28") = 0 Then .Offset(0, 6) = "" .Offset(0, 6).Interior.ColorIndex = 0 Else: .Offset(0, 6) = Sheets(cel.Value).Range("M28") If .Offset(0, 6) <= 2 And .Offset(0, 6) > 0 Then Union(.Offset(0, 0), .Offset(0, 6)).Interior.ColorIndex = 3 End If End If 'Abo Horseball .Offset(0, 8) = Sheets(cel.Value).Range("L43") If Val(Sheets(cel.Value).Range("L43")) > 0 And Sheets(cel.Value).Range("M43") = 0 Then .Offset(0, 9) = "A renouveller ?" Union(.Offset(0, 0), .Offset(0, 9)).Interior.ColorIndex = 3 ElseIf Val(Sheets(cel.Value).Range("L43")) = 0 And Sheets(cel.Value).Range("M43") = 0 Then .Offset(0, 9) = "" .Offset(0, 9).Interior.ColorIndex = 0 Else: .Offset(0, 9) = Sheets(cel.Value).Range("M43") If .Offset(0, 9) <= 2 And .Offset(0, 9) > 0 Then Union(.Offset(0, 0), .Offset(0, 9)).Interior.ColorIndex = 3 ElseIf .Offset(0, 0).Interior.ColorIndex = 3 Then .Offset(0, 9).Interior.ColorIndex = 0 End If End If End With Next cel End With End Sub

Pour tes boutons, il n'est pas possible de les colorier mais tu peux changer la couleur de la police de caractère. C'est peut être moins bien mais l'avantage est que chacun pourra utiliser le fichier (windows ou MAC OS) voire remanier ou changer les boutons.
Exemple, sous MAC il n'est plus possible d'enlever des boutons comme tu les as dessinés et cela provoque un bug lors de l'exacution de n'importe quelle macro.

Amicalement

Dan

PS : N'oublie pas le RESOLU sur le fil si tu en as terminé avec ta demande.
Merci de ta participation.

case à cocher qui rend possible l'écriture dans une plage

Utilisateurs en ligne