Feuille de temps sous Excel

**texas2607** · 07/05/2021, 19h01

Bonjour,
Je tourne en rond sous excel avec des calculs de date.
En fait j'ai besoin de faire un tableau "Feuille de temps" mais je voudrais que :
- Lorsque j'ouvre la feuille Excel puisse détecter le mois en cours (mai actuellement et me demande si je veux actualiser les données, pour éviter que si j'ouvre une feuille d'un mois précédent toutes les données soient faussées)
- Ensuite sur la 1ere colonne, il me faudrait en A2 le 1er jour du mois actuel mais sans tenir compte des samedi et des dimanche (Actuellement A2 serait : Lundi 3 mai 2021 le mois d'avril en A2 il y aurait Jeudi 1er )
- Puis que sur les lignes A3,A4,A5... il me mette les dates suivantes mais en s'arrêtant au vendredi inclus (donc avoir une semaine hors week end)
- Sous le vendredi je dois rajouter une ligne :"Total"
- Ensuite à compter, dans l'exemple de la ligne A7 repartir avec la semaine suivante et ainsi de suite.

Le résultat serait pour ce mois de mai 2021

Lundi 3 mai 2021
Mardi 4 mai 2021
Mercredi 5 mai 2021
Jeudi 6 mai 2021
Vendredi 7 mai 2021
TOTAL
Lundi 10 mai 2021
Mardi 11 mai 2021
Mercredi 12 mai 2021
Jeudi 13 mai 2021
Vendredi 14 mai 2021
TOTAL
Lundi 17 mai 2021
Mardi 18 mai 2021
Mercredi 19 mai 2021
Jeudi 20 mai 2021
Vendredi 21 mai 2021
TOTAL
Lundi 24 mai 2021
Mardi 25 mai 2021
Mercredi 26 mai 2021
Jeudi 27 mai 2021
Vendredi 28 mai 2021
TOTAL
Lundi 30 mai 2021
TOTAL

D'avance merci pour votre aide
Fred

Invité · 08/05/2021, 05h32

Envoyé par texas2607

Bonjour,

En VBA, ce calendrier pourrait être construit avec ce code :

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
45
46
47
48
49
50
51
52
53
54
 
Option Explicit
 
Sub CreationCalendrierMensuel()
 
Dim ShMois As Worksheet
Dim I As Integer, MoisEnCours As Integer, LigneEncours As Integer, DerniereLigne As Integer
Dim DatesEnCours As Date
 
    MoisEnCours = Month(Date)
    Set ShMois = Sheets.Add(after:=Sheets(Sheets.Count))
 
    With ShMois
 
         With .Cells(1, 1)
               .Value = "Jours ouvrés"
               .Font.Bold = True
         End With
 
         LigneEncours = 2
         For DatesEnCours = CDate("01/01/" & Year(Date)) To CDate("31/12/" & Year(Date))
             If Month(DatesEnCours) = MoisEnCours Then
                Select Case WorksheetFunction.Weekday(DatesEnCours, 2)
                       Case 1 To 5
                            .Cells(LigneEncours, 1) = Format(DatesEnCours, "dd/mm/yyyy dddd")
                            '.Cells(LigneEncours, 1) = Format(DatesEnCours, "dd/mm/yyyy") ' Si le nom du jour ne doit pas apparaître
                            LigneEncours = LigneEncours + 1
                       Case 6
                            If LigneEncours > 2 Then
                                With .Cells(LigneEncours, 1)
                                      .Value = "TOTAL"
                                      .Font.Bold = True
                                End With
                                LigneEncours = LigneEncours + 1
                            End If
              End Select
            End If
        Next DatesEnCours
 
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(DerniereLigne, 1) <> "TOTAL" Then
           With .Cells(DerniereLigne + 1, 1)
                .Value = "TOTAL"
                .Font.Bold = True
           End With
        End If
 
        .Columns(1).AutoFit
 
    End With
 
    Set ShMois = Nothing
 
End Sub

Pièce jointe 597446

En incluant cette fonction de Laurent LONGRE pour identifier les jours fériées du calendrier français :

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
 
 
'Cette fonction renvoie 0 si le jour passé en paramètre est un jour de semaine,
'1 s'il s'agit d'un samedi ou d'un dimanche et 2 s'il s'agit d'un jour férié.
'Valide jusqu'en 2099 et pour les jours fériés français
 
Function TypeJour(D As Date)
'L. Longre
Dim A As Integer, T As Integer
Dim LP As Date, LD As Long
 
    A = Year(D)
    If A > 2099 Then
        TypeJour = CVErr(xlErrValue)
        Exit Function
    End If
    LD = Int(D)
    If LD <= 2 Then
        If LD = 1 Then TypeJour = 2
        Exit Function
    End If
    T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
    LP = DateSerial(A, 3, 2) + T + (T > 48) _
         + 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
    Select Case D
        ' Jours fériés mobiles
        Case Is = LP, Is = LP + 38, Is = LP + 49
            TypeJour = 2
        ' Jours fériés fixes
        Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
            Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
            Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
            Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
                TypeJour = 2
        Case Else
        ' Samedi ou dimanche
            If Weekday(D, vbMonday) >= 6 Then TypeJour = 1
    End Select
 
End Function

Le code devient :

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Option Explicit
 
Sub CreationCalendrierMensuel()
 
Dim ShMois As Worksheet
Dim I As Integer, MoisEnCours As Integer, LigneEncours As Integer, DerniereLigne As Integer
Dim DatesEnCours As Date
 
    MoisEnCours = Month(Date)
    Set ShMois = Sheets.Add(after:=Sheets(Sheets.Count))
 
    With ShMois
 
         With .Cells(1, 1)
               .Value = "Jours ouvrés"
               .Font.Bold = True
         End With
 
         LigneEncours = 2
         For DatesEnCours = CDate("01/01/" & Year(Date)) To CDate("31/12/" & Year(Date))
             If Month(DatesEnCours) = MoisEnCours Then
                Select Case WorksheetFunction.Weekday(DatesEnCours, 2)
                       Case 1 To 5
                            With .Cells(LigneEncours, 1)
                                 .Value = Format(DatesEnCours, "dd/mm/yyyy dddd")
                                 If TypeJour(DatesEnCours) = 2 Then
                                    .Interior.Color = RGB(255, 255, 0)
                                 End If
                            End With
 
                            '.Cells(LigneEncours, 1) = Format(DatesEnCours, "dd/mm/yyyy") ' Si le nom du jour ne doit pas apparaître
                            LigneEncours = LigneEncours + 1
                       Case 6
                            If LigneEncours > 2 Then
                                With .Cells(LigneEncours, 1)
                                      .Value = "TOTAL"
                                      .Font.Bold = True
                                End With
                                LigneEncours = LigneEncours + 1
                            End If
              End Select
            End If
        Next DatesEnCours
 
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(DerniereLigne, 1) <> "TOTAL" Then
           With .Cells(DerniereLigne + 1, 1)
                .Value = "TOTAL"
                .Font.Bold = True
           End With
        End If
 
        .Columns(1).AutoFit
 
    End With
 
    Set ShMois = Nothing
 
End Sub

Le résultat :
Pièce jointe 597447

**ARTURO83** · 08/05/2021, 08h32

Bonjour,

Autre solution par formule et MFC

*****************************************************************************************************************
Si on fait d'après la date du jour:
Formule en A2:

Code :

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

1
2
=SI(JOURSEM(DATE(ANNEE(AUJOURDHUI());MOIS(AUJOURDHUI());"1");2)=5;DATE(ANNEE(AUJOURDHUI());MOIS(AUJOURDHUI());"1");
SI(JOURSEM(DATE(ANNEE(AUJOURDHUI());MOIS(AUJOURDHUI());"1");2)=6;DATE(ANNEE(AUJOURDHUI());MOIS(AUJOURDHUI());"3");DATE(ANNEE(AUJOURDHUI());MOIS(AUJOURDHUI());"2")))

Formule en A3:

Code :

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

=SI(A2="TOTAL";AUJOURDHUI()+3;SI(JOURSEM(A2;2)>=5;"TOTAL";SI(MOIS(A2+1)<>MOIS(AUJOURDHUI());"TOTAL";A2+1)))

Formule en A4 jusqu'à A29:

Code :

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

=SI(A3="TOTAL";A2+3;SI(JOURSEM(A3;2)>=5;"TOTAL";SI(MOIS(A3+1)<>MOIS(AUJOURDHUI());"TOTAL";A3+1)))

******************************************************************************************************
Pour les MFC, Formule en A2, à appliquer sur la plage A2:A29:

Code :

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

=ET(MOIS(A2)<>MOIS(AUJOURDHUI());A2<>"TOTAL")

Pour les MFC, Formule en A26, à appliquer sur la plage A26:A29:

Code :

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

=ET($A26="TOTAL";MOIS($A25)<>MOIS(AUJOURDHUI()))

******************************************************************************************************

Si la date du jour était dans une cellule, pour toutes les formules, il suffirait de remplacer "AUJOURDHUI()" par la cellule en question.

Le fichier en exemple:
Pièce jointe 597453

Cdlt

**texas2607** · 08/05/2021, 11h34

Bonjour,
Merci pour vos réponses qui collent parfaitement, super boulot.

J'ai regardé de plus près et en fait ma 1ere demande à découlé sur d'autres souci (comme souvent d'ailleurs)

Pour les dates cela fonctionne nickel (merci merci) mais j'ai un phénomène cascade qui du coup se fait sur mes autres colonnes.

1- Les mois n'ont pas tous le même nombre de jour et le 1er jour hors week-end peut être n'importe lequel et du coup mon tableau (Col B à H) est faussé .
Si ce tableau est ouvert au mois de juillet par exemple, alors les dates (col A) seront nickel mais tout le reste du tableau sera décalé.

J'ai fais une ébauche avec la finalité du tableau.
PS: Les différentes cases sont remplies par les salariés sauf les lignes "Total", "Total mensuel" ainsi que le calcul final qui sont "automatisé".

Merci merci
Fred

Invité · 08/05/2021, 13h59

Envoyé par texas2607

Dans ma solution, il faut calculer la ligne de départ pour que les lignes de totalisation s'alignent avec celles des formules :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
    MoisEnCours = 7 'Month(Date)
    Set ShMois = Sheets("Modèle")
 
    With ShMois
 
         LigneEncours = 0
         For DatesEnCours = CDate("01/01/" & Year(Date)) To CDate("31/12/" & Year(Date))
             If Month(DatesEnCours) = MoisEnCours Then
                Select Case WorksheetFunction.Weekday(DatesEnCours, 2)
                       Case 1 To 5
                            If LigneEncours = 0 Then
                              LigneEncours = 1 + WorksheetFunction.Weekday(DatesEnCours, 2)
                            End If

**texas2607** · 08/05/2021, 15h18

Peux tu me donner un fichier exemple car là je n'ai pas suivi

Merci

Invité · 08/05/2021, 16h16

Envoyé par texas2607

Pour illustrer ma réponse, ci-dessous le résultat des mois de novembre et décembre. Les dates s'alignent pour que les lignes TOTAL s'alignent avec les lignes comportant les formules de totalisation. Il faut ajouter une semaine de plus dans le tableau pour répondre à tous les cas de décalage.

Pièce jointe 597475

Le code ci-dessous traite une année complète à partir d'un onglet "Modèle". Les lignes vides peuvent être masquées.

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
 
Option Explicit
 
Sub GenererLesCalendriers()
 
Dim J As Integer
 
    Application.ScreenUpdating = False
    For J = 1 To 12
        CreationCalendriersMensuels J
    Next J
    Application.ScreenUpdating = True
 
 
End Sub
 
Sub CreationCalendriersMensuels(ByVal MoisACreer As Integer)
 
Dim ShMois As Worksheet
Dim I As Integer, MoisEnCours As Integer, LigneEncours As Integer, DerniereLigne As Integer
Dim DatesEnCours As Date
Dim AireJours As Range
 
 
    MoisEnCours = MoisACreer
    Sheets("Modèle").Copy after:=Sheets(Sheets.Count)
    Set ShMois = ActiveSheet
 
    With ShMois
 
         Set AireJours = .Range(.Cells(2, 1), .Cells(30, 1))
         AireJours.Clear
 
         LigneEncours = 0
         For DatesEnCours = CDate("01/01/" & Year(Date)) To CDate("31/12/" & Year(Date))
             If Month(DatesEnCours) = MoisEnCours Then
                Select Case WorksheetFunction.Weekday(DatesEnCours, 2)
                       Case 1 To 5
                            If LigneEncours = 0 Then
                              LigneEncours = 1 + WorksheetFunction.Weekday(DatesEnCours, 2)
                            End If
                            With .Cells(LigneEncours, 1)
                                 .Value = Format(DatesEnCours, "dd/mm/yyyy dddd")
                                 If TypeJour(DatesEnCours) = 2 Then
                                    .Interior.Color = RGB(255, 255, 0)
                                 End If
                            End With
 
                            LigneEncours = LigneEncours + 1
                       Case 6
                            If LigneEncours > 2 Then
                                With .Cells(LigneEncours, 1)
                                      .Value = "TOTAL"
                                      .Font.Bold = True
                                End With
                                LigneEncours = LigneEncours + 1
                            End If
              End Select
            End If
        Next DatesEnCours
 
        For I = AireJours.Count To 1 Step -1
           With AireJours(I)
                Select Case .Value
                       Case ""
                            .Offset(0, 1).ClearContents
                         '  .EntireRow.Hidden = True    ' Pour masquer les lignes vides
                       Case "TOTAL"
 
                       Case Else
                           If .Interior.Color = RGB(255, 255, 0) Then
                                .Offset(0, 1).ClearContents
                           Else
                               .Offset(0, 1) = 1
                           End If
                End Select
 
           End With
        Next I
 
    End With
 
    Set AireJours = Nothing
    Set ShMois = Nothing
 
End Sub
 
 
 
'Cette fonction renvoie 0 si le jour passé en paramètre est un jour de semaine,
'1 s'il s'agit d'un samedi ou d'un dimanche et 2 s'il s'agit d'un jour férié.
'Valide jusqu'en 2099 et pour les jours fériés français
 
Function TypeJour(D As Date)
'L. Longre
Dim A As Integer, T As Integer
Dim LP As Date, LD As Long
 
    A = Year(D)
    If A > 2099 Then
        TypeJour = CVErr(xlErrValue)
        Exit Function
    End If
    LD = Int(D)
    If LD <= 2 Then
        If LD = 1 Then TypeJour = 2
        Exit Function
    End If
    T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
    LP = DateSerial(A, 3, 2) + T + (T > 48) _
         + 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
    Select Case D
        ' Jours fériés mobiles
        Case Is = LP, Is = LP + 38, Is = LP + 49
            TypeJour = 2
        ' Jours fériés fixes
        Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
            Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
            Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
            Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
                TypeJour = 2
        Case Else
        ' Samedi ou dimanche
            If Weekday(D, vbMonday) >= 6 Then TypeJour = 1
    End Select
 
End Function

**texas2607** · 08/05/2021, 16h34

Super c'est exactement ça.
Aurais-tu un fichier à me faire passer avec ces formules ?

D'avance merci
Fred

**Raccourcix** · 08/05/2021, 16h41

Bonjour

Personnellement, avec l'expérience, je ne suis pas fan de ces tableaux et les contraintes qu'ils imposent (un onglet par mois, du VBA ou des formules complexe ...)

Je préfère un tableau structuré annuel avec tous les jours de l'année y compris férié et WE, des formules pour déterminer ces fériés et WE, le n° de semaine, le mois
Des filtres pour choisir le mois et ne pas afficher les WE et fériés
Pas de sous-totaux dans le tableau mais une synthèse en dessus avec la totalisation des semaines du mois sélectionné (par formule ou tableau croisé)

C'est dynamique (pour 2022), rapide, on peut ajouter ensuite un TCD pour des totaux sur l'année entière. Et si j'ai plusieurs tableaux de ce type, Power Query me permettra en quelques secondes d'obtenir une synthèse annuelle de tous ces fichiers

Un exemple pour illustrer mes propos.
j'utile AGREGAT pour déterminer la première semaine du mois puis un SOMME.SI.ENS ou un NB.SI.ENS pour sommer ou compter les éléments renseignés.
je n'ai pas filtré sur uniquement les jours ouvrés pour visualiser l'ensemble

Nom : 2021_05_08 Tableau Temp.JPG
Affichages : 243
Taille : 114,6 Ko

Nom : 2021_05_08 Tableau Temp.JPG
Affichages : 243
Taille : 114,6 Ko

Bon courage pour votre projet

Stéphane

**texas2607** · 08/05/2021, 16h47

Bonjour,

Envoyé par Raccourcix

je ne suis pas fan de ces tableaux et les contraintes qu'ils imposent (un onglet par mois, du VBA ou des formules complexe ...)

D'accord avec toi mais dans mon cas, pour l'instant, c'est une feuille que j'envoi à mes commerciaux. Il la remplisse puis me la retourne.
Je tente de simplifier au max et donc si ils ont une feuille qui s'actualise à la demande c'est pas mal du tout et cela permet d'avoir quelque chose d'uniforme car par la suite je dois tout rapatrier au même endroit.... Mais ça, c'est la prochaine étape

Merci pour ton intérêt

Cdt,
Fred

Invité · 08/05/2021, 17h55

Envoyé par texas2607

C'est ton fichier. J'ai seulement changé le nom de l'onglet "Feuil1" en "Modèle" et j'ai ajouté une semaine supplémentaire comme dans les vidages d'écran.

**texas2607** · 08/05/2021, 18h27

Envoyé par Eric KERGRESSE

C'est ton fichier. J'ai seulement changé le nom de l'onglet "Feuil1" en "Modèle" et j'ai ajouté une semaine supplémentaire comme dans les vidages d'écran.

Ah ok, et tes codes je les colle ou et comment du coup ?
Merci

Invité · 08/05/2021, 18h42

Envoyé par texas2607

Il faut transformer ton fichier en .xlsm, ouvrir l'éditeur VBA avec Alt-F11, créer un module standard et coller les codes dans la partie droite de l'écran qui correspond au contenu du module.

Pièce jointe 597479

Pièce jointe 597480

**texas2607** · 09/05/2021, 09h01

Bonjour
Alors j'ai peut-être mal fait les choses mais j'ai 2 soucis.
J'ai nommé ma feuil1 en "Modèle" et j'ai collé les codes dans "Module1"

Nom : Capture d’écran 2021-05-09 084846.png
Affichages : 218
Taille : 47,3 Ko

Nom : Capture d’écran 2021-05-09 084846.png
Affichages : 218
Taille : 47,3 Ko

et là le calcul ne se lance pas à l'ouverture et si je force le lancement de GenererLesCalendriers() alors cela fonctionne sauf que j'ai 13 feuilles qui sont crées : Modèle(2) à Modèle(13)

Invité · 09/05/2021, 09h10

Envoyé par texas2607

et là le calcul ne se lance pas à l'ouverture et si je force le lancement de GenererLesCalendriers() alors cela fonctionne sauf que j'ai 13 feuilles qui sont crées : Modèle(2) à Modèle(13)

Bonjour,

C'est normal, il y a 12 mois dans l'année et il n'y a pas d'événement programmé à l'ouverture.

**texas2607** · 09/05/2021, 20h16

En fait mauvaise compréhension, j'envoi en début de mois une feuille excel où mes commerciaux rentres les jours travaillés sur mois-1 puis ils me les retournent par mail.
J'ai simplement besoin d'une feuille qui se met à jour pour éviter que je me la fasse en manuelle.
Donc 1 fichier envoyé (par exemple le 2 ou 3 mai qui correspond aux jours travaillés en avril) pour le commercial, il ouvre le fichier, celui-ci se met à jour en fonction du mois, il remplis ses jours travaillés, RTT, congés.... puis me le retourne par mail.

Invité · 10/05/2021, 03h34

Envoyé par texas2607

Il t'aura sans doute échappé que tu obtiens ce que tu souhaites en donnant le numéro du mois à J dans la procédure GenererLesCalendriers.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub GenererLesCalendriers()
 
Dim J As Integer
 
    J = 4
 
  '  Application.ScreenUpdating = False
  '  For J = 1 To 12
        CreationCalendriersMensuels J
  '  Next J
  '  Application.ScreenUpdating = True
 
 End Sub

Ce n'est pas une mauvaise compréhension de ma part car j'aurais à faire ce travail, je constituerais le fichier pour l'année entière, j'ajouterais une table des commerciaux avec leur mail et un contrôle ActiveX pour envoyer le mois choisi par mail, mais nous ne sommes plus dans l'objet de cette discussion.

**texas2607** · 13/05/2021, 10h28

Bonjour,
Désolé sur le retard.
J'arrive à modifier pas mal de choses et cela fonctionne bien, il reste juste une chose :

Le VBA rajoute bien la ligne "Total" au bon endroit mais pas pour toutes les fins de mois (en A31), Sur les mois de Mars, Avril, Mai, Juin, Aout, Septembre, Novembre, Décembre pas de ligne "Total" en A31

Est-ce qu'il serait possible d'avoir le nom des feuilles en fonction du mois : Janvier 2021, Février 2021... au lieu de Modèle(2), Modèle(3)... ?

Cdt
Fred

Invité · 13/05/2021, 11h04

Envoyé par texas2607

Je n'ai pas ce problème, car il y a toujours 5 jours dans chaque semaine représentée comme dans le message #7 et on ne touche jamais aux lignes de totalisation dans le code.