bonjour j'aimerais réalisé un planing journalier je joint un fichier déja travaillé avec quelque explication dessus
si quelqu'un peu m'aider
merci
si quelqu'un peu m'aider
merci
Option Explicit
Sub Colorie(Zone As Range)
'Permet de matérialiser une période de temps sur le planning
'Appelé par l'évenementiel changement de la feuille en cours
' Zone contient la cellule appelante
'
'Déclaration des variables
Dim Début As String, Durée As String, Cible As String
Dim DebZone As String, FinZone As String, Fin As String
Dim Trouve As Range
Dim Ligne As Long, PointeurDeb As Long, PointeurFin As Long, Décale As Long
'Décodage de l'adresse de la cellule appelante
Cible = Zone.Address
'Détermine la ligne en cours de mise à jour
Ligne = Split(Cible, "$")(2)
'Si texte cellule appelante de longueur inférieure à 2 caractères et différent de minuit
If Len(Range(Cible)) < 2 And Range(Cible).Text <> "0:00" Then
'Mise à zéro de l'ensemble des cellules de la ligne
Range("I" & Ligne & ":BE" & Ligne).ClearContents
Else
'Si heure valide
'Enregistre l'heure dans Début
Début = CDate(Range(Cible))
'Enregistre l'heure de fin , soit la cellule à droite de celle du début
Fin = CDate(Range(Cible).Offset(0, 1))
'Calcul de la différence entre début et 2 h00
Décale = DateDiff("n", "02:00:00", Début)
'Si différence inférieure ou égale , c'est donc le jour suivant
If Décale <= 0 Then
'Décalage de l'heure de début à + 1 jour
Début = DateAdd("d", 1, Début)
'Décalage de l'heure de fin à + 1 jour
Fin = DateAdd("d", 1, Fin)
End If
'Calcul du pointeur de début soit la différence entre 2 h
' et l'heure visée divisé par l'untié de temps du planning soit 30 mn
PointeurDeb = DateDiff("n", "02:00:00", Début) / 30
'Calcul du pointeur de fin , idem au calcul pointeurDébut
PointeurFin = DateDiff("n", "02:00:00", Fin) / 30
'Résolution de l'adresse de début de zone à coloriée
DebZone = Range("I" & Ligne).Offset(0, PointeurDeb).Address
'Résolution de l'adresse de Fin de zone à coloriée
FinZone = Range("I" & Ligne).Offset(0, PointeurFin).Address
'Mise à zéro de l'ensemble des cellules de la ligne
Range("I" & Ligne & ":BE" & Ligne).ClearContents
'Marquage des cellule via un espace pour que la MFC prenne le relai
Range(DebZone & ":" & FinZone) = " "
End If
End Sub