"Ranger" des Valeurs dans des cellules - Planning Annuel

ETI

XLDnaute Nouveau
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 :DV3 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.

Exemple-2015.jpg

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.

Exemple-2017.jpg

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.
 

Pièces jointes

  • Exemple-2015.jpg
    Exemple-2015.jpg
    28.2 KB · Affichages: 153
  • Exemple-2015.jpg
    Exemple-2015.jpg
    28.2 KB · Affichages: 156
  • Exemple-2017.jpg
    Exemple-2017.jpg
    30 KB · Affichages: 81
  • Exemple-2017.jpg
    Exemple-2017.jpg
    30 KB · Affichages: 78

ETI

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

Ca ne semble pas marcher avec : "(" & Cible.Column + Cible.Columns.Count & "-COLUMN())/2" & Z2 & ")"
ni avec "COLUMNS(C:C" & Cible.Column + Cible.Columns.Count - 1 & ")/2" & Z2 & ")"
 

Dranreb

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

Chez moi ça marche. C'est la lignes suite commune des deux instructions dont la ligne de début ne change pas jusqu'au bout:
)=1," & Z1 & _

P.S. On peut peut être le préparer dans des variables supplémentaires pour que ce soit plus clair :
VB:
Sub MoisSemaineJour(ByVal Cible As Range, ByVal DateDép As Date)
Dim Choix As String, NbJoursDébut As String, NbJoursFin As String, Liste As String
Application.ScreenUpdating = False
Cible.Rows(4).NumberFormat = "dd"
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(TEXT(R[1]C,""jjj""))"
NbJoursFin = "COLUMNS(C:C" & Cible.Column + Cible.Columns.Count - 1 & ")/2"
Choix = "CHOOSE(MIN("
NbJoursDébut = "8-WEEKDAY(R[2]C,2)"
Liste = ",3),""S. "",""Sem. "",""Semaine "")&NO.SEMAINE(R[2]C,2)"
Cible.Rows(2).FormulaR1C1 = "=IF(WEEKDAY(R[2]C,2)=1," & Choix & NbJoursFin & Liste & ")"
Cible(2, 1).FormulaR1C1 = "=" & Choix & NbJoursDébut & Liste
Cible.Rows(1).NumberFormat = "General"
Choix = "PROPER(TEXT(R[3]C,CHOOSE(MIN("
NbJoursDébut = "DATE(YEAR(R[3]C),MONTH(R[3]C)+1,1)-R[3]C"
Liste = ",3),""mmm"",""mmm aa"",""mmmm aaaa"")))"
Cible.Rows(1).FormulaR1C1 = "=IF(DAY(R[3]C)=1," & Choix & NbJoursFin & Liste & ")"
Cible(1, 1).FormulaR1C1 = "=" & Choix & NbJoursDébut & Liste
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
Cible.ColumnWidth = 2.5
End Sub
 
Dernière édition:

ETI

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

Bonjour,

Excusez moi pour le retard à l'allumage, j'étais malade à crever.
Je me suis replonger dans le code, voilà où j'en suis :

Code:
Sub RecalerPlanning()

 ' Définit la valeur de l'année (An) comme égale au Nom de la Feuille du Classeur
 
 An = ActiveSheet.Name
 
 ' Définit la valeur Jour1 comme égale au premier jour de l'année (An)
 
 Dim Début As Date, Jour1 As Date
  
 Jour1 = DateSerial(An, 1, 1)
 
 ' Définit la valeur Début comme égale au Lundi de la semaine 01 de l'année (An)
 
 If Weekday(Jour1, vbMonday) = 1 Then
 Début = Jour1
 Else
 Début = DateSerial(An, 1, 1 - (Weekday(Jour1, vbMonday) - 1))
 End If
 
 ' Lance la fonction MoisSemaineJour pour les 365 jours de l'année + le décalage
 
 MoisSemaineJour [C3].Resize(4, (DateSerial(An + 1, 1, 1) - Début) * 2), Début
 End Sub
 '
 '
 
 
' Définit la fonction MoisSemaineJour selon
' Cible : Plage de Cellule (sur 4 lignes, de Début au 1er jour de l'année suivante)
' et DateDép : la date de départ (Début)

Sub MoisSemaineJour(ByVal Cible As Range, ByVal DateDép As Date)
 
 Application.ScreenUpdating = False
 
 ' Place la 4ème ligne de la plage de cellule (Cible) les jours de l'année en format 01, 02, 03, etc.
 Cible.Rows(4).NumberFormat = "dd"
 Cible(4, 1).Value = DateDép: Cible(4, 2).Value = CVErr(xlErrValue)
 Cible(4, 3).Resize(, Cible.Columns.Count - 2).FormulaR1C1 = "=RC[-2]+1"
 
 ' Place la 3ème ligne de la plage de cellule (Cible) les jours de l'année en format Lun, Mar, Mer, etc.
 Cible.Rows(3).FormulaR1C1 = "=PROPER(LEFT(TEXT(R[1]C,""jjj""),2))"
 
 ' Place la 2ème ligne de la plage de cellule (Cible) les semaines de l'année en format Semaine 01, Semaine 02, etc.
 
 Dim Choix As String, NbJoursDébut As String, NbJoursFin As String, Liste As String
 
 NbJoursFin = "COLUMNS(C:C" & Cible.Column + Cible.Columns.Count - 1 & ")/2"
 Choix = "CHOOSE(MIN("
 NbJoursDébut = "8-WEEKDAY(R[2]C,2)"
 Liste = ",3),""S. "",""Sem. "",""Semaine "")&NO.SEMAINE(R[2]C,2)"
 
 Cible.Rows(2).FormulaR1C1 = "=IF(WEEKDAY(R[2]C,2)=1," & Choix & NbJoursFin & Liste & ")"
 Cible(2, 1).FormulaR1C1 = "=" & Choix & NbJoursDébut & Liste
 
 Cible.Rows(1).NumberFormat = "General"
 Choix = "PROPER(TEXT(R[3]C,CHOOSE(MIN("
 NbJoursDébut = "DATE(YEAR(R[3]C),MONTH(R[3]C)+1,1)-R[3]C"
 Liste = ",3),""mmm"",""mmm aa"",""mmmm aaaa"")))"
 Cible.Rows(1).FormulaR1C1 = "=IF(DAY(R[3]C)=1," & Choix & NbJoursFin & Liste & ")"
 Cible(1, 1).FormulaR1C1 = "=" & Choix & NbJoursDébut & Liste
 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
 Cible.ColumnWidth = 2.5
End Sub

Les semaines ne fonctionnent toujours pas. Il n'y aucune valeur sur toute la ligne.
Ce qui me surprend c'est que ça marche tres bien pour tout le reste ...
Petite question : que renvoi Cible.Column ? autant je comprend Cible.Columns.Count, autant je ne vois pas la différence entre Cible.Column et Column()
 

Dranreb

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

Bonsoir.
Si ça n'a jamais marché c'est peut être qu'il manque ce qui est dit dans l'aide :
NO.SEMAINE

Voir aussi
Renvoie le numéro d'ordre de la semaine dans l'année.
Si cette fonction n'est pas disponible et renvoie la valeur d'erreur #NOM?, installez et chargez la macro complémentaire Utilitaire d'analyse.
Sinon, on peut apparemment aussi remplacer
NO.SEMAINE(R[2]C,2)"
par :
Code:
(R[2]C-WEEKDAY(R[2]C,2)-DATE(YEAR(R[2]C),1,-WEEKDAY(DATE(YEAR(R[2]C),1,1),2)-6))/7"

Column sans "s" est le numéro de colonne de début du Range dans la feuille.
 
Dernière édition:

ETI

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

Bonjour,

En remplaçant la formule NO.SEMAINE(R[2]C,2)" ça marche ... merci.

Par contre, je n'avais aucun lag ... et maintenant ça rame un peu.
Ai je moyen de "simplifier" en supprimant les CHOOSE(MIN( ...
Comme je fais mes plannings sur la totalité de l'année le nombre de colonne est toujours supérieur à 3.

En tout cas merci pour le temps que vous m'avez consacré.
 

Dranreb

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

Bonjour.
Essayez, qu'est ce que vous voulez que je vous dise. Tâchez de comprendre un peu comment ça marche et inspirez vous en.
Moi j'ai écrit une procédure à usage général qui met des entêtes à partir d'une certaine date pour un certain nombre de jours.
Si vous, vous l'utilisez toujours pour la même chose vous pouvez peut être la simplifier. Par exemple ne pas recalculer les semaines, ou alors beaucoup plus simplement en se basant uniquement sur le numéro de colonne, puisqu'en principe ce sont toujours les mêmes. Mais pour l'année, il peut vous en rester 3 jour ou moins de l'année précédente pour la 1ère semaine, et si vous voulez toujours un nombre entier de semaines, la dernière peut aussi mordre de 3 jours ou moins sur l'année suivante. Donc il vous faut le CHOOSE pour le mois de l'année.
 
Dernière édition:

Statistiques des forums

Discussions
312 097
Messages
2 085 257
Membres
102 844
dernier inscrit
atori2