Je souhaite appliquer une mise à jour à 12 feuilles Excel (12 mois de
l'année).
Problème : je ne peux sélectionner les 12 pages pour en faire un array, car
bien que la mise en forme soit la même sur les 12 feuilles elle ne se situe
pas sur les mêmes colonnes :
Je colorie d'une couleur les week end, et leur donne la taille2
Les jours de semaine ont la taille 4
Evidement, les weekend ne tombent pas au même endroit (sur les mêmes
colonnes tous les mois).
J'ai donc créé une macro pour la mise à jour, et une autre qui regarde
feuille à feuille si la mise à jour doit être faite, et appelle la procédure
de mise en forme si elle est nécessaire.
Problème : au bout du troisième Call, j'ai le rejet Out of Stack.
Avez-vous une idée pour appliquer ma procédure de mise en forme feuille à
feuille, sans être obligée de répéter 12 fois la même procédure dans des Sub
indépendantes ?
Macro de mise en Forme :
Je démarre, mois de Janvier (5ème feuille du classeur), cellule F4
Sub colorweekend2()
If ActiveCell.Offset(-1, 0) <> "" Then
GoTo boucle2
End If
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = ""
ActiveCell.Interior.ColorIndex = 16
ActiveCell.Select
Selection.Copy
ActiveCell.Range("A1:A127").Select
ActiveSheet.Paste
ActiveCell.ColumnWidth = 2
ActiveCell.Offset(0, 1).Activate
boucle2:
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0)
<> ""
ActiveCell.Offset(1, 0).Interior.ColorIndex = 15
For v = 1 To 126 Step 2
ActiveCell.Offset(v, 0).Interior.ColorIndex = 15
Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop
Loop
Call colorweekend3
End Sub
(Merci à Daniel du forum sur ce coup!!)
et voici celle qui test et appel cette procédure si nécéssaire :
Sub colorweekend3()
Sheets("FEVRIER").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo mars
End If
Call colorweekend2
mars:
Sheets("MARS").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo avril
End If
Call colorweekend2
avril:
Sheets("AVRIL").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo mai
End If
Call colorweekend2
Je vous passe la suite, j'ai fait pareil pour tous les mois. Out of Stack
apparaît sur avril, sur la ligne d'appel de procédure.
J'ai essayé de remplacer ce fouilli par :
For s = 6 To 16
Sheets(s).Select
If Range("F5").Interior.ColorIndex = 15 Then
Sheets(s + 1).Select
End If
Call colorweekend2
Next s
Beaucoup plus court, mais c'est pareil, elle s'arrête à la fin du mois de
Mars, "Out of Stack", Avril n'est pas mis à jour.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
JLuc
*Bonjour vswildcat*, Tu as fait un mauvais choix dans ta procedure "Sub colorweekend2()". Il est tres fortement deconseiller d'utiliser des boucles sauvages avec le mot "Goto" surtout a l'interieur de deux boucles "While" imbriquées. Je crois (mais pas completement sur) que Out of Stack veux dire qu'il y a trop de repetitions de boucles. Pourquoi ne passe tu pas par une mise en forme conditionnelle ? Si tu veux une couleur pour les weekend, tu doit surement avoir les dates
Bonjour,
Je souhaite appliquer une mise à jour à 12 feuilles Excel (12 mois de l'année).
Problème : je ne peux sélectionner les 12 pages pour en faire un array, car bien que la mise en forme soit la même sur les 12 feuilles elle ne se situe pas sur les mêmes colonnes :
Je colorie d'une couleur les week end, et leur donne la taille2 Les jours de semaine ont la taille 4
Evidement, les weekend ne tombent pas au même endroit (sur les mêmes colonnes tous les mois).
J'ai donc créé une macro pour la mise à jour, et une autre qui regarde feuille à feuille si la mise à jour doit être faite, et appelle la procédure de mise en forme si elle est nécessaire.
Problème : au bout du troisième Call, j'ai le rejet Out of Stack.
Avez-vous une idée pour appliquer ma procédure de mise en forme feuille à feuille, sans être obligée de répéter 12 fois la même procédure dans des Sub indépendantes ?
Macro de mise en Forme :
Je démarre, mois de Janvier (5ème feuille du classeur), cellule F4
Sub colorweekend2()
If ActiveCell.Offset(-1, 0) <> "" Then GoTo boucle2 End If Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16 ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A127").Select ActiveSheet.Paste ActiveCell.ColumnWidth = 2 ActiveCell.Offset(0, 1).Activate
boucle2:
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15 For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop Loop Call colorweekend3 End Sub
(Merci à Daniel du forum sur ce coup!!)
et voici celle qui test et appel cette procédure si nécéssaire :
Sub colorweekend3()
Sheets("FEVRIER").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo mars End If Call colorweekend2 mars: Sheets("MARS").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo avril End If Call colorweekend2 avril: Sheets("AVRIL").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo mai End If Call colorweekend2
Je vous passe la suite, j'ai fait pareil pour tous les mois. Out of Stack apparaît sur avril, sur la ligne d'appel de procédure.
J'ai essayé de remplacer ce fouilli par :
For s = 6 To 16
Sheets(s).Select If Range("F5").Interior.ColorIndex = 15 Then Sheets(s + 1).Select End If Call colorweekend2
Next s
Beaucoup plus court, mais c'est pareil, elle s'arrête à la fin du mois de Mars, "Out of Stack", Avril n'est pas mis à jour.
Par avance, merci de votre aide,
Wildcat
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
*Bonjour vswildcat*,
Tu as fait un mauvais choix dans ta procedure "Sub colorweekend2()".
Il est tres fortement deconseiller d'utiliser des boucles sauvages avec
le mot "Goto" surtout a l'interieur de deux boucles "While" imbriquées.
Je crois (mais pas completement sur) que Out of Stack veux dire qu'il y
a trop de repetitions de boucles.
Pourquoi ne passe tu pas par une mise en forme conditionnelle ? Si tu
veux une couleur pour les weekend, tu doit surement avoir les dates
Bonjour,
Je souhaite appliquer une mise à jour à 12 feuilles Excel (12 mois de
l'année).
Problème : je ne peux sélectionner les 12 pages pour en faire un array, car
bien que la mise en forme soit la même sur les 12 feuilles elle ne se situe
pas sur les mêmes colonnes :
Je colorie d'une couleur les week end, et leur donne la taille2
Les jours de semaine ont la taille 4
Evidement, les weekend ne tombent pas au même endroit (sur les mêmes
colonnes tous les mois).
J'ai donc créé une macro pour la mise à jour, et une autre qui regarde
feuille à feuille si la mise à jour doit être faite, et appelle la procédure
de mise en forme si elle est nécessaire.
Problème : au bout du troisième Call, j'ai le rejet Out of Stack.
Avez-vous une idée pour appliquer ma procédure de mise en forme feuille à
feuille, sans être obligée de répéter 12 fois la même procédure dans des Sub
indépendantes ?
Macro de mise en Forme :
Je démarre, mois de Janvier (5ème feuille du classeur), cellule F4
Sub colorweekend2()
If ActiveCell.Offset(-1, 0) <> "" Then
GoTo boucle2
End If
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = ""
ActiveCell.Interior.ColorIndex = 16
ActiveCell.Select
Selection.Copy
ActiveCell.Range("A1:A127").Select
ActiveSheet.Paste
ActiveCell.ColumnWidth = 2
ActiveCell.Offset(0, 1).Activate
boucle2:
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0)
<> ""
ActiveCell.Offset(1, 0).Interior.ColorIndex = 15
For v = 1 To 126 Step 2
ActiveCell.Offset(v, 0).Interior.ColorIndex = 15
Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop
Loop
Call colorweekend3
End Sub
(Merci à Daniel du forum sur ce coup!!)
et voici celle qui test et appel cette procédure si nécéssaire :
Sub colorweekend3()
Sheets("FEVRIER").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo mars
End If
Call colorweekend2
mars:
Sheets("MARS").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo avril
End If
Call colorweekend2
avril:
Sheets("AVRIL").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo mai
End If
Call colorweekend2
Je vous passe la suite, j'ai fait pareil pour tous les mois. Out of Stack
apparaît sur avril, sur la ligne d'appel de procédure.
J'ai essayé de remplacer ce fouilli par :
For s = 6 To 16
Sheets(s).Select
If Range("F5").Interior.ColorIndex = 15 Then
Sheets(s + 1).Select
End If
Call colorweekend2
Next s
Beaucoup plus court, mais c'est pareil, elle s'arrête à la fin du mois de
Mars, "Out of Stack", Avril n'est pas mis à jour.
*Bonjour vswildcat*, Tu as fait un mauvais choix dans ta procedure "Sub colorweekend2()". Il est tres fortement deconseiller d'utiliser des boucles sauvages avec le mot "Goto" surtout a l'interieur de deux boucles "While" imbriquées. Je crois (mais pas completement sur) que Out of Stack veux dire qu'il y a trop de repetitions de boucles. Pourquoi ne passe tu pas par une mise en forme conditionnelle ? Si tu veux une couleur pour les weekend, tu doit surement avoir les dates
Bonjour,
Je souhaite appliquer une mise à jour à 12 feuilles Excel (12 mois de l'année).
Problème : je ne peux sélectionner les 12 pages pour en faire un array, car bien que la mise en forme soit la même sur les 12 feuilles elle ne se situe pas sur les mêmes colonnes :
Je colorie d'une couleur les week end, et leur donne la taille2 Les jours de semaine ont la taille 4
Evidement, les weekend ne tombent pas au même endroit (sur les mêmes colonnes tous les mois).
J'ai donc créé une macro pour la mise à jour, et une autre qui regarde feuille à feuille si la mise à jour doit être faite, et appelle la procédure de mise en forme si elle est nécessaire.
Problème : au bout du troisième Call, j'ai le rejet Out of Stack.
Avez-vous une idée pour appliquer ma procédure de mise en forme feuille à feuille, sans être obligée de répéter 12 fois la même procédure dans des Sub indépendantes ?
Macro de mise en Forme :
Je démarre, mois de Janvier (5ème feuille du classeur), cellule F4
Sub colorweekend2()
If ActiveCell.Offset(-1, 0) <> "" Then GoTo boucle2 End If Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16 ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A127").Select ActiveSheet.Paste ActiveCell.ColumnWidth = 2 ActiveCell.Offset(0, 1).Activate
boucle2:
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15 For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop Loop Call colorweekend3 End Sub
(Merci à Daniel du forum sur ce coup!!)
et voici celle qui test et appel cette procédure si nécéssaire :
Sub colorweekend3()
Sheets("FEVRIER").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo mars End If Call colorweekend2 mars: Sheets("MARS").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo avril End If Call colorweekend2 avril: Sheets("AVRIL").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo mai End If Call colorweekend2
Je vous passe la suite, j'ai fait pareil pour tous les mois. Out of Stack apparaît sur avril, sur la ligne d'appel de procédure.
J'ai essayé de remplacer ce fouilli par :
For s = 6 To 16
Sheets(s).Select If Range("F5").Interior.ColorIndex = 15 Then Sheets(s + 1).Select End If Call colorweekend2
Next s
Beaucoup plus court, mais c'est pareil, elle s'arrête à la fin du mois de Mars, "Out of Stack", Avril n'est pas mis à jour.
Par avance, merci de votre aide,
Wildcat
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
JLuc
*Bonjour vswildcat*,
Sub colorweekend3()
Sheets("FEVRIER").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo mars End If Call colorweekend2 mars: Sheets("MARS").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo avril End If Call colorweekend2 avril: Sheets("AVRIL").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo mai End If Call colorweekend2
Je vous passe la suite, j'ai fait pareil pour tous les mois. Out of Stack apparaît sur avril, sur la ligne d'appel de procédure.
Pour t'éviter une proc si longue et avec des branchements sauvages, utilise ceci : Recupere deja les nom des mois exacts (ils sont avec accent pour quelques uns). Ca les met sur une feuille, apres c'est qu'un copier coller pour modifier le nom de l'onglet
Sub recupererlesmois() For x = 1 To 12 Sheets("Feuil1").Cells(1, 1).Offset(x - 1, 0) = UCase(Format(DateSerial(2006, x, 1), "MMMM")) Next End Sub
Et là, cà raccourci pas mal hein ? et plus de boucle sauvage. Au lieu de tester si est egal a 15, si oui sortir; je teste si different de 15 et là si oui j'appelle ta procedure
Sub colorweekend3() For x = 1 To 12 feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm")) Sheets(feuille).Select If Range("F5").Interior.ColorIndex <> 15 Then Call colorweekend2 End If Next End Sub
Pour la procedure colorweekend2, je regarde
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
*Bonjour vswildcat*,
Sub colorweekend3()
Sheets("FEVRIER").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo mars
End If
Call colorweekend2
mars:
Sheets("MARS").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo avril
End If
Call colorweekend2
avril:
Sheets("AVRIL").Select
If Range("F5").Interior.ColorIndex = 15 Then
GoTo mai
End If
Call colorweekend2
Je vous passe la suite, j'ai fait pareil pour tous les mois. Out of Stack
apparaît sur avril, sur la ligne d'appel de procédure.
Pour t'éviter une proc si longue et avec des branchements sauvages,
utilise ceci :
Recupere deja les nom des mois exacts (ils sont avec accent pour
quelques uns). Ca les met sur une feuille, apres c'est qu'un copier
coller pour modifier le nom de l'onglet
Sub recupererlesmois()
For x = 1 To 12
Sheets("Feuil1").Cells(1, 1).Offset(x - 1, 0) =
UCase(Format(DateSerial(2006, x, 1), "MMMM"))
Next
End Sub
Et là, cà raccourci pas mal hein ? et plus de boucle sauvage. Au lieu
de tester si est egal a 15, si oui sortir; je teste si different de 15
et là si oui j'appelle ta procedure
Sub colorweekend3()
For x = 1 To 12
feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm"))
Sheets(feuille).Select
If Range("F5").Interior.ColorIndex <> 15 Then
Call colorweekend2
End If
Next
End Sub
Sheets("FEVRIER").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo mars End If Call colorweekend2 mars: Sheets("MARS").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo avril End If Call colorweekend2 avril: Sheets("AVRIL").Select If Range("F5").Interior.ColorIndex = 15 Then GoTo mai End If Call colorweekend2
Je vous passe la suite, j'ai fait pareil pour tous les mois. Out of Stack apparaît sur avril, sur la ligne d'appel de procédure.
Pour t'éviter une proc si longue et avec des branchements sauvages, utilise ceci : Recupere deja les nom des mois exacts (ils sont avec accent pour quelques uns). Ca les met sur une feuille, apres c'est qu'un copier coller pour modifier le nom de l'onglet
Sub recupererlesmois() For x = 1 To 12 Sheets("Feuil1").Cells(1, 1).Offset(x - 1, 0) = UCase(Format(DateSerial(2006, x, 1), "MMMM")) Next End Sub
Et là, cà raccourci pas mal hein ? et plus de boucle sauvage. Au lieu de tester si est egal a 15, si oui sortir; je teste si different de 15 et là si oui j'appelle ta procedure
Sub colorweekend3() For x = 1 To 12 feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm")) Sheets(feuille).Select If Range("F5").Interior.ColorIndex <> 15 Then Call colorweekend2 End If Next End Sub
Pour la procedure colorweekend2, je regarde
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
JLuc
*Bonjour vswildcat*, Alors voila : Je n'arrive pas trop a suivre ce que doit faire ta procedure mais un gros probleme detecter en relisant : Tu execute (je pense) colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 ... et ainsi de suite. C'est un peu normal que tu tombe sur Out of Track ! dans colorweekend2 supprime l'appelle à colorweekend3 deja et reessaie
For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop Loop Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
*Bonjour vswildcat*,
Alors voila :
Je n'arrive pas trop a suivre ce que doit faire ta procedure mais un
gros probleme detecter en relisant :
Tu execute (je pense) colorweekend3 qui appelle colorweekend2 qui
appelle colorweekend3 qui appelle colorweekend2 qui appelle
colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 ...
et ainsi de suite. C'est un peu normal que tu tombe sur Out of Track !
dans colorweekend2 supprime l'appelle à colorweekend3 deja et reessaie
For v = 1 To 126 Step 2
ActiveCell.Offset(v, 0).Interior.ColorIndex = 15
Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop
Loop
Call colorweekend3
End Sub
*Bonjour vswildcat*, Alors voila : Je n'arrive pas trop a suivre ce que doit faire ta procedure mais un gros probleme detecter en relisant : Tu execute (je pense) colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 ... et ainsi de suite. C'est un peu normal que tu tombe sur Out of Track ! dans colorweekend2 supprime l'appelle à colorweekend3 deja et reessaie
For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop Loop Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
vswildcat
Bonjour JLuc,
Je comprends bien qu'il y a trop d'aller retour et que ça ne lui plait pas, mais voilà :
Mes feuilles sont déjà nommées : donc pas de problème de ce côté La mise en forme fait 2 choses différentes :
Si la cellule sur laquelle apparaît le jour est vide (week end ou jour férié, ce que je fais avant avec une formule) Alors colorie en gris foncé la celulle Copie la cellule Et colle sur les 126 ligne suivantes
Si la cellule sur laquelle apparaît le jour est non vide (offset(-1,0)) Colorie la celule sur le row suivant en gris clair (offset(1,0)) et recommence a colorié en gris clair une ligne sur 2 (For v=1 to 126)
La macro doit donc se déplacer sur la droite (pour tester les cellules sur lesquelles le jour apparaît), et vers le bas quand la cellule n'es pas vide pour colorié une ligne sur deux.
Sachant en outre que le premier jour du mois peut être vide ou non vide (ca peut-être un week end ou un jour férié) ce qui explique que j'ai prévu le IF de départ avec un GoTo.
Donc je dois faire recommencer la macro : - colone par colone (test des celulles où le jour apparaît ou non) - feuille après feuille pour répété la mise en forme sur les 12 feuilles
Peut-être ai-je voulu faire trop compliqué : un copié/collé du format des cellules "week end" tous les 5 jours, idem pour le format des cellules "semaines" serait peut-être la solution...
Ainsi, il n'y as plus de boucle dans colorweekend2, mais il restera tout de même à appeller 11 fois la procédure de mise en forme, et je crois vraiment que c'est ça qui ne lui plait pas...
Par contre ton histoire de ColorIndex <> 15 m'a fait gagné un mois : la mise à jour se fait maintenant jusqu'au mois d'Avril inclu, et Out of Stack pour le mois de Mai :-)
As-tu une autre idée ?
*Bonjour vswildcat*, Alors voila : Je n'arrive pas trop a suivre ce que doit faire ta procedure mais un gros probleme detecter en relisant : Tu execute (je pense) colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 ... et ainsi de suite. C'est un peu normal que tu tombe sur Out of Track ! dans colorweekend2 supprime l'appelle à colorweekend3 deja et reessaie
For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop Loop Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
Bonjour JLuc,
Je comprends bien qu'il y a trop d'aller retour et que ça ne lui plait pas,
mais voilà :
Mes feuilles sont déjà nommées : donc pas de problème de ce côté
La mise en forme fait 2 choses différentes :
Si la cellule sur laquelle apparaît le jour est vide (week end ou jour
férié, ce que je fais avant avec une formule)
Alors colorie en gris foncé la celulle
Copie la cellule
Et colle sur les 126 ligne suivantes
Si la cellule sur laquelle apparaît le jour est non vide (offset(-1,0))
Colorie la celule sur le row suivant en gris clair (offset(1,0))
et recommence a colorié en gris clair une ligne sur 2 (For v=1 to 126)
La macro doit donc se déplacer sur la droite (pour tester les cellules sur
lesquelles le jour apparaît), et vers le bas quand la cellule n'es pas vide
pour colorié une ligne sur deux.
Sachant en outre que le premier jour du mois peut être vide ou non vide (ca
peut-être un week end ou un jour férié) ce qui explique que j'ai prévu le IF
de départ avec un GoTo.
Donc je dois faire recommencer la macro :
- colone par colone (test des celulles où le jour apparaît ou non)
- feuille après feuille pour répété la mise en forme sur les 12 feuilles
Peut-être ai-je voulu faire trop compliqué : un copié/collé du format des
cellules "week end" tous les 5 jours, idem pour le format des cellules
"semaines" serait peut-être la solution...
Ainsi, il n'y as plus de boucle dans colorweekend2, mais il restera tout de
même à appeller 11 fois la procédure de mise en forme, et je crois vraiment
que c'est ça qui ne lui plait pas...
Par contre ton histoire de ColorIndex <> 15 m'a fait gagné un mois : la mise
à jour se fait maintenant jusqu'au mois d'Avril inclu, et Out of Stack pour
le mois de Mai
:-)
As-tu une autre idée ?
*Bonjour vswildcat*,
Alors voila :
Je n'arrive pas trop a suivre ce que doit faire ta procedure mais un
gros probleme detecter en relisant :
Tu execute (je pense) colorweekend3 qui appelle colorweekend2 qui
appelle colorweekend3 qui appelle colorweekend2 qui appelle
colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 ...
et ainsi de suite. C'est un peu normal que tu tombe sur Out of Track !
dans colorweekend2 supprime l'appelle à colorweekend3 deja et reessaie
For v = 1 To 126 Step 2
ActiveCell.Offset(v, 0).Interior.ColorIndex = 15
Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop
Loop
Call colorweekend3
End Sub
Je comprends bien qu'il y a trop d'aller retour et que ça ne lui plait pas, mais voilà :
Mes feuilles sont déjà nommées : donc pas de problème de ce côté La mise en forme fait 2 choses différentes :
Si la cellule sur laquelle apparaît le jour est vide (week end ou jour férié, ce que je fais avant avec une formule) Alors colorie en gris foncé la celulle Copie la cellule Et colle sur les 126 ligne suivantes
Si la cellule sur laquelle apparaît le jour est non vide (offset(-1,0)) Colorie la celule sur le row suivant en gris clair (offset(1,0)) et recommence a colorié en gris clair une ligne sur 2 (For v=1 to 126)
La macro doit donc se déplacer sur la droite (pour tester les cellules sur lesquelles le jour apparaît), et vers le bas quand la cellule n'es pas vide pour colorié une ligne sur deux.
Sachant en outre que le premier jour du mois peut être vide ou non vide (ca peut-être un week end ou un jour férié) ce qui explique que j'ai prévu le IF de départ avec un GoTo.
Donc je dois faire recommencer la macro : - colone par colone (test des celulles où le jour apparaît ou non) - feuille après feuille pour répété la mise en forme sur les 12 feuilles
Peut-être ai-je voulu faire trop compliqué : un copié/collé du format des cellules "week end" tous les 5 jours, idem pour le format des cellules "semaines" serait peut-être la solution...
Ainsi, il n'y as plus de boucle dans colorweekend2, mais il restera tout de même à appeller 11 fois la procédure de mise en forme, et je crois vraiment que c'est ça qui ne lui plait pas...
Par contre ton histoire de ColorIndex <> 15 m'a fait gagné un mois : la mise à jour se fait maintenant jusqu'au mois d'Avril inclu, et Out of Stack pour le mois de Mai :-)
As-tu une autre idée ?
*Bonjour vswildcat*, Alors voila : Je n'arrive pas trop a suivre ce que doit faire ta procedure mais un gros probleme detecter en relisant : Tu execute (je pense) colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 qui appelle colorweekend2 qui appelle colorweekend3 ... et ainsi de suite. C'est un peu normal que tu tombe sur Out of Track ! dans colorweekend2 supprime l'appelle à colorweekend3 deja et reessaie
For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop Loop Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
JLuc
*Bonjour vswildcat*, Essaie avec ces procédures modifiées (renomme les tiennes et copie celles ci)
Sub colorweekend3() Table = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", _ "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE") For Each feuille In Table 'feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm")) Sheets(feuille).Select If Range("F5").Interior.ColorIndex <> 15 Then Call colorweekend2 End If Next End Sub
Sub colorweekend2() If ActiveCell.Offset(-1, 0) <> "" Then GoTo boucle2 End If Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16 ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A127").Select ActiveSheet.Paste ActiveCell.ColumnWidth = 2 ActiveCell.Offset(0, 1).Activate Loop Exit Sub boucle2: Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15 For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop 'Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
*Bonjour vswildcat*,
Essaie avec ces procédures modifiées (renomme les tiennes et copie
celles ci)
Sub colorweekend3()
Table = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN",
"JUILLET", _
"AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
For Each feuille In Table
'feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm"))
Sheets(feuille).Select
If Range("F5").Interior.ColorIndex <> 15 Then
Call colorweekend2
End If
Next
End Sub
Sub colorweekend2()
If ActiveCell.Offset(-1, 0) <> "" Then
GoTo boucle2
End If
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) =
""
ActiveCell.Interior.ColorIndex = 16
ActiveCell.Select
Selection.Copy
ActiveCell.Range("A1:A127").Select
ActiveSheet.Paste
ActiveCell.ColumnWidth = 2
ActiveCell.Offset(0, 1).Activate
Loop
Exit Sub
boucle2:
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <>
""
ActiveCell.Offset(1, 0).Interior.ColorIndex = 15
For v = 1 To 126 Step 2
ActiveCell.Offset(v, 0).Interior.ColorIndex = 15
Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop
'Call colorweekend3
End Sub
*Bonjour vswildcat*, Essaie avec ces procédures modifiées (renomme les tiennes et copie celles ci)
Sub colorweekend3() Table = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", _ "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE") For Each feuille In Table 'feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm")) Sheets(feuille).Select If Range("F5").Interior.ColorIndex <> 15 Then Call colorweekend2 End If Next End Sub
Sub colorweekend2() If ActiveCell.Offset(-1, 0) <> "" Then GoTo boucle2 End If Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16 ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A127").Select ActiveSheet.Paste ActiveCell.ColumnWidth = 2 ActiveCell.Offset(0, 1).Activate Loop Exit Sub boucle2: Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15 For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop 'Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
JLuc
*ReBonjour vswildcat*, Ou celle ci sans branchement sauvage :
Sub colorweekend2() If ActiveCell.Offset(-1, 0) = "" Then Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16 ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A127").Select ActiveSheet.Paste ActiveCell.ColumnWidth = 2 ActiveCell.Offset(0, 1).Activate Loop Else Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15 For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop End If 'Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
*ReBonjour vswildcat*,
Ou celle ci sans branchement sauvage :
Sub colorweekend2()
If ActiveCell.Offset(-1, 0) = "" Then
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) =
""
ActiveCell.Interior.ColorIndex = 16
ActiveCell.Select
Selection.Copy
ActiveCell.Range("A1:A127").Select
ActiveSheet.Paste
ActiveCell.ColumnWidth = 2
ActiveCell.Offset(0, 1).Activate
Loop
Else
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0)
<> ""
ActiveCell.Offset(1, 0).Interior.ColorIndex = 15
For v = 1 To 126 Step 2
ActiveCell.Offset(v, 0).Interior.ColorIndex = 15
Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop
End If
'Call colorweekend3
End Sub
*ReBonjour vswildcat*, Ou celle ci sans branchement sauvage :
Sub colorweekend2() If ActiveCell.Offset(-1, 0) = "" Then Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16 ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A127").Select ActiveSheet.Paste ActiveCell.ColumnWidth = 2 ActiveCell.Offset(0, 1).Activate Loop Else Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15 For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop End If 'Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
vswildcat
J'AI TROUVE !!! Ca m'ennerve tellement c'est simple...
En fait, j'ai encadré mes deux boucles avec mon changement de feuille !!!
For s = 5 To 16 Sheets(s).Select
If ActiveCell.Offset(-1, 0) <> "" Then GoTo boucle2 End If
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15
For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop Loop
Next s
Tout simplement... Ainsi, feuille 5 = janvier, il lit la procédure et fait la mise en forme, next s = 6, donc février, et ainsi de suite jusqu'à décembre :-))
Merci beaucoup JLuc de t'être pris la tête avec moi, je n'ai pas testé ta dernière proposition, mais je pense que, comme tu me l'a dit dans tes précédents messages, les boucles et les allers/retours de procédures sont trop gourmands en mémoire, avec ma combine, il ne reste que les boucles, et je supprime les allers/retours de procédures...
Encore merci
Wildcat
*Bonjour vswildcat*, Essaie avec ces procédures modifiées (renomme les tiennes et copie celles ci)
Sub colorweekend3() Table = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", _ "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE") For Each feuille In Table 'feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm")) Sheets(feuille).Select If Range("F5").Interior.ColorIndex <> 15 Then Call colorweekend2 End If Next End Sub
Sub colorweekend2() If ActiveCell.Offset(-1, 0) <> "" Then GoTo boucle2 End If Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16 ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A127").Select ActiveSheet.Paste ActiveCell.ColumnWidth = 2 ActiveCell.Offset(0, 1).Activate Loop Exit Sub boucle2: Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15 For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop 'Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
J'AI TROUVE !!! Ca m'ennerve tellement c'est simple...
En fait, j'ai encadré mes deux boucles avec mon changement de feuille !!!
For s = 5 To 16
Sheets(s).Select
If ActiveCell.Offset(-1, 0) <> "" Then
GoTo boucle2
End If
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = ""
ActiveCell.Interior.ColorIndex = 16
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0)
<> ""
ActiveCell.Offset(1, 0).Interior.ColorIndex = 15
For v = 1 To 126 Step 2
ActiveCell.Offset(v, 0).Interior.ColorIndex = 15
Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop
Loop
Next s
Tout simplement... Ainsi, feuille 5 = janvier, il lit la procédure et fait
la mise en forme, next s = 6, donc février, et ainsi de suite jusqu'à
décembre :-))
Merci beaucoup JLuc de t'être pris la tête avec moi, je n'ai pas testé ta
dernière proposition, mais je pense que, comme tu me l'a dit dans tes
précédents messages, les boucles et les allers/retours de procédures sont
trop gourmands en mémoire, avec ma combine, il ne reste que les boucles, et
je supprime les allers/retours de procédures...
Encore merci
Wildcat
*Bonjour vswildcat*,
Essaie avec ces procédures modifiées (renomme les tiennes et copie
celles ci)
Sub colorweekend3()
Table = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN",
"JUILLET", _
"AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
For Each feuille In Table
'feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm"))
Sheets(feuille).Select
If Range("F5").Interior.ColorIndex <> 15 Then
Call colorweekend2
End If
Next
End Sub
Sub colorweekend2()
If ActiveCell.Offset(-1, 0) <> "" Then
GoTo boucle2
End If
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) =
""
ActiveCell.Interior.ColorIndex = 16
ActiveCell.Select
Selection.Copy
ActiveCell.Range("A1:A127").Select
ActiveSheet.Paste
ActiveCell.ColumnWidth = 2
ActiveCell.Offset(0, 1).Activate
Loop
Exit Sub
boucle2:
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <>
""
ActiveCell.Offset(1, 0).Interior.ColorIndex = 15
For v = 1 To 126 Step 2
ActiveCell.Offset(v, 0).Interior.ColorIndex = 15
Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop
'Call colorweekend3
End Sub
Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15
For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v
ActiveCell.ColumnWidth = 4
ActiveCell.Offset(0, 1).Activate
Loop Loop
Next s
Tout simplement... Ainsi, feuille 5 = janvier, il lit la procédure et fait la mise en forme, next s = 6, donc février, et ainsi de suite jusqu'à décembre :-))
Merci beaucoup JLuc de t'être pris la tête avec moi, je n'ai pas testé ta dernière proposition, mais je pense que, comme tu me l'a dit dans tes précédents messages, les boucles et les allers/retours de procédures sont trop gourmands en mémoire, avec ma combine, il ne reste que les boucles, et je supprime les allers/retours de procédures...
Encore merci
Wildcat
*Bonjour vswildcat*, Essaie avec ces procédures modifiées (renomme les tiennes et copie celles ci)
Sub colorweekend3() Table = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", _ "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE") For Each feuille In Table 'feuille = UCase(Format(DateSerial(2006, x, 1), "mmmm")) Sheets(feuille).Select If Range("F5").Interior.ColorIndex <> 15 Then Call colorweekend2 End If Next End Sub
Sub colorweekend2() If ActiveCell.Offset(-1, 0) <> "" Then GoTo boucle2 End If Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) = "" ActiveCell.Interior.ColorIndex = 16 ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A127").Select ActiveSheet.Paste ActiveCell.ColumnWidth = 2 ActiveCell.Offset(0, 1).Activate Loop Exit Sub boucle2: Do While ActiveCell.Address <> "$AL$4" And ActiveCell.Offset(-1, 0) <> "" ActiveCell.Offset(1, 0).Interior.ColorIndex = 15 For v = 1 To 126 Step 2 ActiveCell.Offset(v, 0).Interior.ColorIndex = 15 Next v ActiveCell.ColumnWidth = 4 ActiveCell.Offset(0, 1).Activate Loop 'Call colorweekend3 End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
JLuc
*Bonjour vswildcat*,
J'AI TROUVE !!! Ca m'ennerve tellement c'est simple... Je suis content pour toi
Merci beaucoup JLuc de t'être pris la tête avec moi, je n'ai pas testé ta dernière proposition, mais je pense que, comme tu me l'a dit dans tes précédents messages, les boucles et les allers/retours de procédures sont trop gourmands en mémoire, avec ma combine, il ne reste que les boucles, et je supprime les allers/retours de procédures... Les allers/retours se font tout seuls !
Sub Proc1() ... ... Proc2 ' Appel de Proc2 ' A la sortie de Proc2, retour AUTOMATIQUE à cette ligne ... ... Proc2 ' Appel de Proc2 ' A la sortie de Proc2, retour AUTOMATIQUE à cette ligne ... ... End Sub
Sub Proc2() ... ... Exit Sub ' par exemple pour sortir en fonction d'un resultat ... ... End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
*Bonjour vswildcat*,
J'AI TROUVE !!! Ca m'ennerve tellement c'est simple...
Je suis content pour toi
Merci beaucoup JLuc de t'être pris la tête avec moi, je n'ai pas testé ta
dernière proposition, mais je pense que, comme tu me l'a dit dans tes
précédents messages, les boucles et les allers/retours de procédures sont
trop gourmands en mémoire, avec ma combine, il ne reste que les boucles, et
je supprime les allers/retours de procédures...
Les allers/retours se font tout seuls !
Sub Proc1()
...
...
Proc2 ' Appel de Proc2
' A la sortie de Proc2, retour AUTOMATIQUE à cette ligne
...
...
Proc2 ' Appel de Proc2
' A la sortie de Proc2, retour AUTOMATIQUE à cette ligne
...
...
End Sub
Sub Proc2()
...
...
Exit Sub ' par exemple pour sortir en fonction d'un resultat
...
...
End Sub
J'AI TROUVE !!! Ca m'ennerve tellement c'est simple... Je suis content pour toi
Merci beaucoup JLuc de t'être pris la tête avec moi, je n'ai pas testé ta dernière proposition, mais je pense que, comme tu me l'a dit dans tes précédents messages, les boucles et les allers/retours de procédures sont trop gourmands en mémoire, avec ma combine, il ne reste que les boucles, et je supprime les allers/retours de procédures... Les allers/retours se font tout seuls !
Sub Proc1() ... ... Proc2 ' Appel de Proc2 ' A la sortie de Proc2, retour AUTOMATIQUE à cette ligne ... ... Proc2 ' Appel de Proc2 ' A la sortie de Proc2, retour AUTOMATIQUE à cette ligne ... ... End Sub
Sub Proc2() ... ... Exit Sub ' par exemple pour sortir en fonction d'un resultat ... ... End Sub
