Microsoft 365 Effacer données planning des semaines precedentes

riton00 à dit:

Bonjour,

Un fichier EXCEL complété par des explications..... anonymisé permettrait aux intervenants de répondre plus précisément à ta question.

Slts

Cliquez pour agrandir...

michaelcolasberna à dit:

Des idées SVP?

Cliquez pour agrandir...

riton00 à dit:

Bonsoir,

La seule chose que je puisse te proposer avec ton calendrier c'est ce que tu trouveras sur la Pj

Slts

Cliquez pour agrandir...

GALOUGALOU à dit:

Pour garder l'historique, il faut renseigner une liste, (dans ce classeur feuille data). Il suffit de choisir l'année dans la feuille planning pour que l'ensemble des informations de l'année choisie, soient renvoyées dans le planning.

La feuille planning pour l'affichage, la feuille data pour les événements, à renseigner en permanence, la feuille liste pour la structure du classeur
Le choix de l'année de la feuille planning déclenché la macro qui va afficher les événements de l'année (plus la couleur police et couleur cellule), renseigné en colonne c de la feuille data.

VB:

Sub Mise_à_jour()
 Dim F1 As String, F2 As String, i As Long, COL As Integer, couleur As Variant

 Dim boecran As Boolean, bobarre As Boolean, boevent As Boolean, bosaut As Boolean
  Dim icalcul As Integer
 
F1 = Sheets("Planning").Name
F2 = Sheets("data").Name
ActiveSheet.Unprotect

'If Not Sheets(F2).Cells(1, 13) = "2" Then

  'on conserve d'abord les configuations existantes
  boecran = Application.ScreenUpdating
  bobarre = Application.DisplayStatusBar
  icalcul = Application.Calculation
  boevent = Application.EnableEvents
  bosaut = ActiveSheet.DisplayPageBreaks
  'on force les configurations
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = False
  Application.Calculation = xlManual
  Application.EnableEvents = False
  ActiveSheet.DisplayPageBreaks = False
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ActiveWindow.FreezePanes = False
 Application.DisplayAlerts = False
'macro ci dessous

Call fusion_no

Calculate

 li = Sheets(F1).Cells(36000, 1).End(xlUp).Row
ligne = Sheets(F2).Cells(36000, 3).End(xlUp).Row

For COL = 2 To 12 Step 2
For i = 8 To 70
For i2 = 2 To ligne
If Sheets(F1).Cells(i, COL) < Sheets(F2).Cells(i2, 2) Then 'test sur l'heure de fin
If Sheets(F1).Cells(i, COL) >= Sheets(F2).Cells(i2, 1) Then 'test sur l'heure de début

Sheets(F1).Cells(i, COL).Offset(0, 1) = Sheets(F2).Cells(i2, 3)  'renvoie la colonne 3
Sheets(F1).Cells(i, COL).Offset(0, 1).Interior.Color = Sheets(F2).Cells(i2, 3).Interior.Color 'récupère la couleur cellule
Sheets(F1).Cells(i, COL).Offset(0, 1).Font.Color = Sheets(F2).Cells(i2, 3).Font.Color   'récupère la couleur police
End If
End If

Next
Next
Next


Call fusion_colonnes
    'configuration restaurée
      Application.ScreenUpdating = boecran
  Application.DisplayStatusBar = bobarre
  Application.Calculation = icalcul
  Application.EnableEvents = boevent
  ActiveSheet.DisplayPageBreaks = bosaut
  ''''''''''''''''''''''''''''''''''''''''''''''''''
         Range("A4").Select
    ActiveWindow.FreezePanes = True
    Application.DisplayAlerts = True
    MsgBox "Mise à jour terminée !"
 
   ' Else

  '  Sheets(F2).Select
     '   MsgBox "Attention, chevauchement !"
   ' End If
   ActiveSheet.Protect
End Sub

les informations saisies dans la feuille data, colonne

Type

Lieu

Horaires

Nb heures

A payer

​ A récup

Etat

sont renvoyés grâce à la formule matricielle suivante (en fonction du numéro de semaine choisi)

Code:

{=SIERREUR(INDEX(data!$E$2:$L$1000;EQUIV(1;(Planning!$E75=data!$E$2:$E$1000)*(Planning!F$74=data!F$1);0);2);"")}

Il manque dans ce classeur le contrôle des chevauchements de date, dite moi si vous êtes intéressé.
cdt
galougalou

Cliquez pour agrandir...