"Ranger" des Valeurs dans des cellules - Planning Annuel

[ETI]

Bonjour,

Après de longues recherches je n'arrive pas à mettre en place un planning annuel qui se remette à jour et surtout se remette en forme automatiquement en fonction des années.
J'ai besoin de sortir toutes les semaines le planning des collaborateurs (en demi-journée), et je souhaiterais arrêter de passer plus de temps à le remettre en forme, qu'à l'utiliser à des fins plus "intéressantes".

Je connais les fonctions de recherche, d’Adresse, d’Indirect, XLM.LIRE.CELLULE me permettant assez facilement de sortir les éléments de suivi du service (comme par exemple le temps passé sur une tache, le nombre de jours de congés restants, etc.). Et je cherche « juste » à caler un planning en fonction de l’année en cours (j’ai une feuille par année – le Nom de la feuille est l’année en cours).

Je me suis débrouillé pour caler les jours et les semaines, avec les formules JOURSEM() et DATE() Et je voudrais réussir Centrer sur plusieurs colonnes les mois (Janvier, Février, etc.) au-dessus des dates correspondantes.
Ainsi pour l’année 2015, en I6 je sais positionner le premier jour de l’année et en I5 le jour de la semaine correspondant. Je cherche donc à centrer sur I3:BR3 le texte « Janvier » (Plage de 1 lignes et 62 colonnes = 31 x 2 demi-journées), puis sur BS3 V3 le texte « Février » (Plage de 1 lignes et 56 colonnes = 28 x 2 demi-journées), et ainsi de suite jusqu’en décembre.



Ce serait super simple si toutes les années commençaient le Lundi, mais je souhaiterais qu’en changeant l’année cela se refasse automatiquement, c.à.d que pour l’année 2017 : à centrer sur O3:BX3 le texte « Janvier », puis sur BY3 :EB3 le texte « Février », et ainsi de suite jusqu’en décembre.



Remerciant par avance tous ceux qui pourront m’aider, n’hésitez pas à me faire préciser des choses, qui ne sont pas forcément claires.

P.S : j’ai essayé Decaler() sans succès, mais je ne maitrise pas du tout.

 

[CISCO]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Bonjour

Cela serait tellement mieux avec les fichiers en pièce jointe, plutot qu'une image... Pour cela --> "Aller en mode avancé" en bas à droite --> "Gestion des fichiers" en dessous de la fenêtre où on écrit le message.

@ plus

 

[Dranreb]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Bonjour.

Essayer ça :

Sub Test()
[2:5].Delete
MoisSemaineJour [B2:AL5], "29/12/13"
End Sub
'

Sub MoisSemaineJour(ByVal Cible As Range, ByVal DateDép As Date)
Dim Z1 As String, Z2 As String
Cible.Rows(4).NumberFormat = "d"
Cible.Rows(4).FormulaR1C1 = "=RC[-1]+1"
Cible(4, 1).Value = DateDép
Cible.Rows(3).FormulaR1C1 = "=PROPER(LEFT(TEXT(R[1]C,""jjj""),2))"
Z1 = "CHOOSE(MIN("
Z2 = ",4),""."",""S. "",""Sem. "",""Semaine "")&NO.SEMAINE(R[2]C,2)"
Cible.Rows(2).FormulaR1C1 = "=IF(R[1]C=""Lu""," & Z1 & _
   Cible.Column + Cible.Columns.Count & "-COLUMN()" & Z2 & ")"
Cible(2, 1).FormulaR1C1 = "=" & Z1 & "8-WEEKDAY(R[2]C,2)" & Z2
Cible.Rows(1).NumberFormat = "General"
Z1 = "PROPER(CHOOSE(MIN(MAX(1,"
Z2 = "-1),4),LEFT(TEXT(R[3]C,""mmm""),1)&""."",TEXT(R[3]C,""mmm""),TEXT(R[3]C,""mmmm""),TEXT(R[3]C,""mmmm aaaa"")))"
Cible.Rows(1).FormulaR1C1 = "=IF(DAY(R[3]C)=1," & Z1 & _
   Cible.Column + Cible.Columns.Count & "-COLUMN()" & Z2 & ")"
Cible(1, 1).FormulaR1C1 = "=" & Z1 & "DATE(YEAR(R[3]C),MONTH(R[3]C)+1,1)-R[3]C" & Z2
Cible.Rows(1).NumberFormat = "@"
Cible.HorizontalAlignment = xlCenterAcrossSelection
Cible.Columns(Cible.Columns.Count + 1).HorizontalAlignment = xlGeneral
Cible.VerticalAlignment = xlCenter
Cible.SpecialCells(xlCellTypeFormulas, 20).ClearContents
Cible.Value2 = Cible.Value
With Cible.Borders: .LineStyle = xlContinuous: .Weight = xlThin: End With
Cible.Rows(1).Borders(xlInsideVertical).Weight = xlThick
Cible.ColumnWidth = 2.5
End Sub

P.S. Oups. J'ai aussi eu du mal à voir sur les images que les jours étaient sur 2 colonnes. Alors, c'est plutôt :

Sub Test()
[2:5].Delete
MoisSemaineJour [B2:BW5], "29/12/13"
Application.ScreenUpdating = True: MsgBox "Fin Test 1"
Const An = 2015
Dim Début As Date
Début = DateSerial(An, 1, 1)
MoisSemaineJour [B2].Resize(4, (DateSerial(An, 4, 1) - Début) * 2), Début
Application.ScreenUpdating = True: MsgBox "Fin Test 2"
Rem. Le Test 3 ne peut pas fonctionner chez moi: je n'ai pas assez de colonnes.
MoisSemaineJour [B2].Resize(4, (DateSerial(An + 1, 1, 1) - Début) * 2), Début
End Sub
'

Sub MoisSemaineJour(ByVal Cible As Range, ByVal DateDép As Date)
Dim Z1 As String, Z2 As String
Application.ScreenUpdating = False
Cible.Rows(4).NumberFormat = "d"
Cible(4, 1).Value = DateDép: Cible(4, 2).Value = CVErr(xlErrValue)
Cible(4, 3).Resize(, Cible.Columns.Count - 2).FormulaR1C1 = "=RC[-2]+1"
'Cible.Rows(3).FormulaR1C1 = "=PROPER(LEFT(TEXT(R[1]C,""jjj""),2))"
Cible.Rows(3).FormulaR1C1 = "=PROPER(TEXT(R[1]C,""jjj""))"
Z1 = "CHOOSE(MIN("
Z2 = ",3),""S. "",""Sem. "",""Semaine "")&NO.SEMAINE(R[2]C,2)"
Cible.Rows(2).FormulaR1C1 = "=IF(WEEKDAY(R[2]C,2)=1," & Z1 & _
   (Cible.Column + Cible.Columns.Count) / 2 & "-COLUMN()/2" & Z2 & ")"
Cible(2, 1).FormulaR1C1 = "=" & Z1 & "8-WEEKDAY(R[2]C,2)" & Z2
Cible.Rows(1).NumberFormat = "General"
Z1 = "PROPER(CHOOSE(MIN(MAX(1,"
Z2 = "-1),4),LEFT(TEXT(R[3]C,""mmm""),1)&""."",TEXT(R[3]C,""mmm""),TEXT(R[3]C,""mmmm""),TEXT(R[3]C,""mmmm aaaa"")))"
Z1 = "PROPER(TEXT(R[3]C,CHOOSE(MIN(MAX(1,"
Z2 = "),3),""mmm"",""mmm aa"",""mmmm aaaa"")))"
Cible.Rows(1).FormulaR1C1 = "=IF(DAY(R[3]C)=1," & Z1 & _
   (Cible.Column + Cible.Columns.Count) / 2 & "-COLUMN()/2" & Z2 & ")"
Cible(1, 1).FormulaR1C1 = "=" & Z1 & "DATE(YEAR(R[3]C),MONTH(R[3]C)+1,1)-R[3]C" & Z2
Cible.Rows(1).NumberFormat = "@"
Cible.HorizontalAlignment = xlCenterAcrossSelection
Cible.Columns(Cible.Columns.Count + 1).HorizontalAlignment = xlGeneral
Cible.VerticalAlignment = xlCenter
Cible.Value2 = Cible.Value
Cible.SpecialCells(xlCellTypeConstants, xlErrors + xlLogical).ClearContents
With Cible.Borders: .LineStyle = xlContinuous: .Weight = xlThin: End With
Cible.Rows(1).Borders(xlInsideVertical).Weight = xlThick
Cible.ColumnWidth = 2.5
End Sub

 

[ETI]

Bonjour,

Test de fichiers en pièces jointes.

 

[Dranreb]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

J"en déduis que vous avez à présent tout ce qu'il vous faut, donc.

 

[ETI]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Bonjour et Merci de votre réponse.

Non, j'ai "juste" remis les ficheirs en pièces jointes.

Je suis en train de tester votre code vb.

 

[ETI]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Merci cela semble fonctionner.
Le premier test semblait fonctionner.
Cependant puis je abuser de votre patience et vous demander comment ne pas décaler les colonnes ou de faire le même centrage des mois, sur les semaines ?
Et d'autre part de le faire sans changer la mise en forme (ne pas avoir de bordures sur les cellules)

 

[Dranreb]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Eh bien vous cadrez convenablement le début de la plage Cible et vous mettez en commentaire les 2 instructions finales avec Borders.
Ou bien vous reculez la date début jusqu'au lundi précédent puis vous effacez après les dates en trop

 

[ETI]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Oui, je suis en train de bidouiller.
Je vous redonnerai ma version (quand ET si) elle marche.

 

[ETI]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

En fait, ca marche pour les années, mais ca ne fonctionne pas pour les semaines.

 

[ETI]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Les semaines disparaissent.

 

[Dranreb]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Joignez un classeur avec ce que vous avez écrit.

 

[ETI]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Je suis en train de modifier le code pour qu'il n'y ait pas de modification de la mise en forme.
ET que la "cible" de MoisSemaineJour commence toujours par un Lundi (que ce soit sur la semaine 52 de l'année précédente ou pas). Cela me permet de garder la mise en forme des 52 semaines.

 

[ETI]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Si j'ai bien compris votre code, normalement j'ai enlevé la partie mettant en forme les cellules.
Je chercherais ensuite comment mettre en forme les semaines, puis les "séparations" des mois

 

[Dranreb]

Re : "Ranger" des Valeurs dans des cellules - Planning Annuel

Vu. Le problème venait d'une dépendance indésirable de la colonne de départ: (Cible.Column + Cible.Columns.Count) / 2 peut se terminer par ",5" et la virgule est prise comme ";"
alors remplaçons :

(Cible.Column + Cible.Columns.Count) / 2 & "-COLUMN()/2" & Z2 & ")"

par :

"(" & Cible.Column + Cible.Columns.Count & "-COLUMN())/2" & Z2 & ")"

en deux endroits
Ou bien par :

"COLUMNS(C:C" & Cible.Column + Cible.Columns.Count - 1 & ")/2" & Z2 & ")"

ça marche aussi.