XL 2013 Graph synchro avec calendrier déroulant.

[Dicas]

Bonjour à toutes et à tous !
le tableau que je joints concerne des résultats d'analyses et d'observations médicales qui sont enregistrés au fil des jours au fur et à mesure des fluctuations de l'état de santé d'un malade.

• Je cherche à rendre automatique le décalage quotidien des enregistrements de ce tableau dont les titres de colonnes sont, autour de "AUJOURDHUI()", vers la gauche les titres "AUJOURDHUI()-1", "AUJOURDHUI()-2" etc.. et vers la droite "AUJOURDHUI()+1","AUJOURDHUI()+2" etc... - La valeur "AUJOURDHUI()" change chaque jour ce qui nécessite de décaler, pour chacune des lignes enregistrées de supprimer la première cellule de gauche de chaque ligne au profit de la création d'une cellule nouvelle à droite.
• Les valeurs de ce tableau "glissant" sont transposées sur un graph qui doit, lui aussi, automatiquement s'actualiser à chaque changement de "AUJOURDHUI()".

Je joints mon énième travail qui sous ces deux aspects, pas davantage que les précédents, ne répond à mes objectifs.
J'ai donc besoin de votre aide pour y parvenir.

 

[Dranreb]

Bonjour.
Vous auriez intérêt à figer la formule =AUJOURDHUI() afin de permettre le calcul du décalage en jours des données à effectuer vers la gauche avant la mise à jour de cette cellule.
Votre projet VBA est protégé par un mot de passe.

 

[Dicas]

Bonjour !! Et désolé pour le Mdp oublié ! C'est "2524"
Je ne comprend pas "figer la formule" mais je précise que la ligne 1 est cachée et que Aujourdhui() y est copié et collé (valeur) à la fin du code.
Est-ce que ça répond à votre remarque ??

 

[Dranreb]

Figer une formule ça signifie la remplacer par sa valeur.
Pas besoin de la formule, ni de la ligne 1.
Vous pourriez par exemple mettre cette procédure dans le module de la feuille :

Private Sub Worksheet_Activate()
Dim Déca As Long, NbCol As Long
Déca = Date - Me.[XU2].Value
If Déca > 0 Then
   Me.[XU2].Value = Date
   With Me.[D5:YA25]: NbCol = .Columns.Count - Déca
      .Resize(, NbCol).Value = .Offset(, Déca).Resize(, NbCol).Value
      .Resize(, Déca).Offset(, NbCol).Value = Empty
      End With: End If
End Sub

 

[Dicas]

Dranred !! Bonjour !!! et merci de votre aide !!!!
Mais, j'ai un pb avec votre proposition. Je n'arrive pas à la mettre en œuvre !
Fonctionne t-elle sur l'application fournie ?

 

[Dranreb]

Bonjour.
Oui, je l'avais essayée.
Qu'est ce qui ne va pas ?
Avez vous bien figé la date en XU2 ?
Avez vous bien mis la procédure dans le module objet de la feuille et non dans un module standard ?