Discussion :

[andre55]

Bonjour à tous,

Voici mon PB, Je souhaite griser ou colorier les cellules d'un Planning quand dans une feuille de pointage d'une personne celle-ci rentre ses dates de presence.. Ci-joint le fichier.


Merci d'avance

[Plateforme3]

Bonjour
J'ai quelque chose à proposer (surement très perfectible)
Tout d'abord dans la feuille "acceuil" mettre tous les jours comm dates avec en format/cellules: j
ceci afin de savoir les reconnaitre plus facilement et d'éviter des formules de conversion
ensuite avec le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub Macro1()
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim WS_Accueil As Worksheet
Dim WS_Collab As Worksheet
Dim Debut As Date
Dim Fin As Date
Dim Nom As String
Dim Ligne_Presence As Integer
 
Set WS_Accueil = Worksheets("acceuil")
 
For I = 1 To ActiveWorkbook.Sheets.Count
    If Worksheets(I).Name <> "acceuil" Then
        Set WS_Collab = Worksheets(I)
        Nom = LCase(WS_Collab.Range("C3"))
        Ligne_Presence = 10
        Do While WS_Collab.Range("K" & Ligne_Presence) <> ""
            Debut = WS_Collab.Range("K" & Ligne_Presence)
            Fin = WS_Collab.Range("L" & Ligne_Presence)
            For J = 1 To 200
                If LCase(WS_Accueil.Cells(J, 1)) = Nom Then
                    K = 2
                    Do While Cells(J, K) <> ""
                        WS_Accueil.Cells(J, K).Select
                        If WS_Accueil.Cells(J, K) >= Debut And WS_Accueil.Cells(J, K) <= Fin Then
                            If Selection.Interior.ColorIndex <> 36 Then
                                With Selection.Interior
                                    .ColorIndex = 42
                                    .Pattern = xlSolid
                                    .PatternColorIndex = xlAutomatic
                                End With
                            End If
                        End If
                        K = K + 1
                    Loop
                End If
            Next
            Ligne_Presence = Ligne_Presence + 1
        Loop
    End If
Next
End Sub

Le principe:
Je regarde toutes les feuilles
Si feuille<>acceuil alors je vais chercher le nom du collaborateur
Je prends les cellules de début et de fin de présence
Dans la feuille acceuil, je teste les cellules de la première colonne, si les noms sont identiques, je vérifie si la date est entre début et fin
Slts