calendrier jours ouvrés sans weekend

A

antiphot

XLDnaute Occasionnel
Bonjour à toutes et à tous

J'utilise depuis longtemps un code (d'Alain Vallon) bien pratique pour créer un calendrier annuel sur une colonne.

Néanmoins j'aimerais apporter une modification afin que seul les jours ouvrés apparaissent.
En bref je ne souhaite pas avoir les samedi et les Dimanche. J'ai pas mal cherché sur le forum et ailleurs et si ce n'est pas le nombre de sujet qui manque sur les jours ouvrés, je n'ai pas trouvé ce sujet.

Si quelqu'un peut me dépanner, je lui en serais reconnaissant

Merci par avance

Code Ci-joint

Sub Calendrier()
'Alain Vallon, mpfe
varAn = Val(InputBox("Année ?", "CALENDRIER"))
If varAn = 0 Then Exit Sub 'clic sur touche Annuler ou la croix
X = DateSerial(varAn, 1, 1)
Y = DateValue("31 décembre " & varAn)
For i = 0 To Y - X
Range("A" & i + 1, "B" & i + 1) = X + i
Next
Columns("A:A").NumberFormat = "dddd"
Columns("A:B").EntireColumn.AutoFit 'pour fignoler
End Sub
 
Trier par date Trier par votes
C@thy

C@thy

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

Yaisse, Dormeur74,
un très très grand MERCI à toi.

ça fonctionne très bien, mais...:eek:

la fin n'est pas le 31/12 mais le 5/11/2013 (série sur 365 jours - les we et fériés à partir de la date du jour (qui ne peut jamais être un férié))

les fériés doivent être variables (ex. si on est en novembre, pâques doit être pâques 2013 sinon 2012...
autrement dit, les fériés sont à venir...

Bises

C@thy
 
Dernière édition:
Vote positif 0 Vote négatif
C@thy

C@thy

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

:eek:Oui, Staple, j'avais zappé car tu as fait un Edit de ton post précédent...

Un immense MERCI itou...

j'ai aussi un bout de code comme ceci :

Sub jferies()
Dim auj As Date, dateVendSaint As Date, datepaques As Date, dateascen As Date, datepente As Date, datejan As Date
Dim date1mai As Date, date8mai As Date, date14j As Date, date15a As Date, date0111 As Date, date1111 As Date, datenoel As Date, date26d As Date
dim num As Integer
mum = Year(Date)
auj = Date
'calcul VENDREDI SAINT
dateVendSaint = IIf(Paques(mum) - 2 > auj, Paques(mum) - 2, Paques(mum + 1) - 2)
'calcul LUNDI DE PAQUES
datepaques = IIf(Paques(mum) > auj, Paques(mum) + 1, Paques(mum + 1) + 1)
'calcul ASCENSION
dateascen = IIf(datepasfor + 38 > auj, datepasfor + 38, Paques(mum + 1) + 38)
'calcul LUNDI DE PENTECOTE
datepente = IIf(datepasfor + 49 > auj, datepasfor + 49, Paques(mum + 1) + 49)
'calcul 1er JANVIER
datejan = IIf(DateSerial(mum, 1, 1) > auj, DateSerial(mum, 1, 1), DateSerial(mum + 1, 1, 1))
'calcul 1er MAI
date1mai = IIf(DateSerial(mum, 5, 1) > auj, DateSerial(mum, 5, 1), DateSerial(mum + 1, 5, 1))
'calcul 1er MAI
date8mai = IIf(DateSerial(mum, 5, 8) > auj, DateSerial(mum, 5, 8), DateSerial(mum + 1, 5, 8))
'calcul 14 JUILLET
date14j = IIf(DateSerial(mum, 7, 14) > auj, DateSerial(mum, 7, 14), DateSerial(mum + 1, 7, 14))
'calcul 15 AOUT
date15a = IIf(DateSerial(mum, 8, 15) > auj, DateSerial(mum, 8, 15), DateSerial(mum + 1, 8, 15))
'calcul 1er NOVEMBRE
date0111 = IIf(DateSerial(mum, 11, 1) > auj, DateSerial(mum, 5, 8), DateSerial(mum + 1, 5, 8))
'calcul 11 NOVEMBRE
date1111 = IIf(DateSerial(mum, 11, 11) > auj, DateSerial(mum, 11, 11), DateSerial(mum + 1, 11, 11))
'calcul NOEL
datenoel = IIf(DateSerial(mum, 12, 25) > auj, DateSerial(mum, 12, 25), DateSerial(mum + 1, 12, 25))
'calcul 26 DECEMBRE
date26d = datenoel + 1
End Sub

Public Function Paques(ByVal an As Integer) As Date
Dim a As Integer
a = (204 - 11 * (an Mod 19)) Mod 30 + 22
Paques = DateSerial(an, 3, a + 6 + (a > 49) - (an + an \ 4 + a + (a > 49)) Mod 7)
End Function

Bizzzz

C@thy
 
Dernière édition:
Vote positif 0 Vote négatif
C@thy

C@thy

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

Très bien aussi, l'agrafe, j'adore le calcul des fériés, mais...:eek::p

le début est la date du jour (qui ne peut jamais être un jour férié) et la fin date du jour + 365

pour le reste je me suis bricolé un truc qui recherche la date du jour dans une colonne et copie les 365 j suivants hors fériés et we en-dessous (au-dessus c'est du passé, n'en parlons plus...:D)

Bisous bisous, et MERCIiiii c SUPERrrrrrr

C@thy
 
Dernière édition:
Vote positif 0 Vote négatif
C@thy

C@thy

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

Yaisse, dormeur (du val)74, cette fois-ci, on y est,

il reste à faire su variable sur les dates car la macro doit fonctionner dans 10 ans (inch'Allah!!!),
mais ça, je peux m'en occuper...

Un très grand MERCI à toi.

Biz et bonne journée,

C@thy
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

Re

Quelq'un peut-il m'expliquer pourquoi les dimanches ne sont pas effacés ???
J'ai beau me creuser les méninges , je ne comprends pas ou le code pêche
Code: 
Sub CalendrierII()
' Macro commise le 06/11/2012 par Staple au petit matin
Application.ScreenUpdating = False
If IsEmpty([A7]) Then [A7] = "1/1/" & Year(Now)
Set Calend = Range("A7:A372") 'on a bien + 365 jours
Range("A7").AutoFill Destination:=[Calend], Type:=xlFillDays
Calend.NumberFormat = "ddd d/mm/yyyy"
For Each c In Calend
If EstFerie(c) Or estsd(c) Then
c.EntireRow.Delete ' c'est que je m'arrache les cheveux
End If
Next c
End Sub
Code: 
Function estsd(D) As Boolean
estsd = (Weekday(D, vbMonday) > 5)
End Function
Code: 
Function EstFerie(D) As Boolean
'd'après Alain Vallon, mpfe
Dim A&, M As Byte
  A = Year(D): M = Month(D) ' variables date jour
  jf1 = DateValue("1/1/" & A) * 1 'Jour de l'A
  If D = jf1 Then GoTo Fin
  jf2 = Evaluate("round(date(" & A & ",4,mod(234-11*mod(" & _
                  A & ",19),30))/7,)*7-6") + 1 'Lundi Pâques
  If D = jf2 Then GoTo Fin
  jf3 = DateValue("1/5/" & A) * 1 ' 1° Mai
  If D = jf3 Then GoTo Fin
  jf4 = DateValue("8/5/" & A) * 1 ' 8 Mai
  If D = jf4 Then GoTo Fin
  jf5 = jf2 + 38 * 1 ' Jeudi Ascension
  If D = jf5 Then GoTo Fin
  jf6 = jf2 + 49 * 1 ' Lundi Pentecôte
  If D = jf6 Then GoTo Fin
  jf7 = DateValue("14/7/" & A) * 1 ' 14 Juillet
  If D = jf7 Then GoTo Fin
  jf8 = DateValue("15/8/" & A) * 1 ' 15 Aout
  If D = jf8 Then GoTo Fin
  jf9 = DateValue("1/11/" & A) * 1 ' Toussaint
  If D = jf9 Then GoTo Fin
  jf10 = DateValue("11/11/" & A) * 1 ' 11 Novembre
  If D = jf10 Then GoTo Fin
  jf11 = DateValue("25/12/" & A) * 1 ' Noël
  If D = jf11 Then GoTo Fin
  Exit Function
Fin:
  EstFerie = True
End Function
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

Re


Note pour plus tard: ne jamais faire de VBA quand le reveil n'est pas complet, ou si votre cerveau est encore embrumé.
J'avais zappé qu'il faut toujours partir de la fin pour deleter des lignes
Code: 
Sub CalendrierIII()
' Macro commise le 06/11/2012 par Staple au petit matin
Dim calend As Range, i&
Application.ScreenUpdating = False
If IsEmpty([A7]) Then [A7] = "1/1/" & Year(Now)
Set calend = Range("A7:A372")
Range("A7").AutoFill Destination:=[calend], Type:=xlFillDays
calend.NumberFormat = "ddd d/mm/yyyy"
For i = Range("A65536").End(xlUp).Row To 7 Step -1
If EstFerie(Cells(i, "A")) Or estsd(Cells(i, "A")) Then
Cells(i, "a").Delete shift:=xlUp
End If
Next i
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
C@thy

C@thy

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

J'avais dit que je m'occupais des fériés de Dormeur74,

voilà, c'est fait!

Bravo à vous deux, vous êtes des chefs... et encore mille mercis.

Euh... Staple, tu veux pas t'appeler Dormeur aussi??? Looool:D:D:D

Big bisous

C@thy
 

Pièces jointes

  • Copie de Liste dates sans WE ni feries2.xls
    37 KB · Affichages: 57
Vote positif 0 Vote négatif
C@thy

C@thy

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

Allez, tiens, je chipote,
juste pour t'embêtrer, l'agrafe,:p:p:p

Set calend = Range("A7:A372") 'soit 366 jours arf!!! tu n'as pas testé le cas des années bissextiles...
aller jusqu'en 371 sauf les années bisexuelles (loool) où il faut aller jusqu'en 372:rolleyes:

J'ai modifié comme suit (pour coller à mes besoins) :
[A7] = Now (date du jour au lieu du 1/1, et j'écrase ce qu'il y avait avant)


P.S. je te taquine, ta macro est très très bien!!!

Bises

C@thy
 
Dernière édition:
Vote positif 0 Vote négatif
Modeste geedee

Modeste geedee

XLDnaute Barbatruc
Re : calendrier jours ouvrés sans weekend

Bonsour®
C@thy à dit:
J'avais dit que je m'occupais des fériés de Dormeur74,

voilà, c'est fait!
C@thy
Cliquez pour agrandir...

la partie du code générant la plage des jours ouvrés peut etre énormement allégée :

VB: 
'***********************************
    [A1] = Date
    Range("A1:A365").Select ' <=====adapter ici l'etendue de la plage
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlWeekday, Step:=1, Trend:=False
   '**************************************************
 
Vote positif 0 Vote négatif

Discussions similaires

Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
459
Nicolas JACQUIN
Nicolas JACQUIN
E
  • Question
Microsoft 365 VBA Calendrier, rien ne se passe.
Réponses
12
Affichages
714
fanch55
fanch55
U
  • Question
Autres [RESOLU] Application.ScreenUpdating = False
Réponses
4
Affichages
974
un internaute
U
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
ERIC S
Michest94
  • Résolu(e)
XL 2016 Optimisation MACROS
2 3
Réponses
38
Affichages
5 K
Michest94
Michest94
Nicolas JACQUIN
  • Question
XL 2016 Optimisation code agenda
Réponses
0
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
R
  • Question
XL 2019 lister fichier avec exifs ou propriétés
Réponses
1
Affichages
1 K
fanch55
fanch55
W
  • Question
Microsoft 365 Placer un RV dans l'agenda Outlook sur calendrier secondaire
Réponses
4
Affichages
3 K
chich
C
Bernard_XLD
  • Suggestion
Date et heure Jours fériés automatiques
Réponses
10
Affichages
9 K
baptistou
B
thunder23
  • Question
XL 2010 Alléger et rendre plus rapide un code VBA
Réponses
10
Affichages
2 K
thunder23
thunder23

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 48 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 836
Messages
2 092 652
Membres
105 479
dernier inscrit
chaussadas.renaud