Case à cocher qui rend possible l'écriture dans une plage
re,
Au lieu du 0, si une date est présente dans la colonne avant, on pourrait mettre une mention "A renouveller" non ?
Dan
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.
Qu'en penses-tu?
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
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!!
re,
Remplace ton code COULEUR par celui-ci
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 SubPour 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
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?
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
après plusieurs tests ... j'ai un peu modifié le code de Dan:
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 Subet maintenant ça joue mais faut pas me demander pourquoi...
A bientôt!!!!
Silvia
re,
essaie ceci :
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 SubPour 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.