calendrier jours ouvrés sans weekend

[antiphot]

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

 

[Staple1600]

Re : calendrier jours ouvrés sans weekend

Bonjour Modeste

Cathy
C'est ce que je proposais plus bas
https://www.excel-downloads.com/threads/calendrier-jours-ouvres-sans-weekend.115076/
On n'est pas trop de deux pour retrouver tes lunettes

 

[C@thy]

Re : calendrier jours ouvrés sans weekend

C'est bien ce que je disais : vous êtes tous de plus en plus forts!!!

Un grand MERCI à vous, boys

Bizz

C@thy

 

[Staple1600]

Re : calendrier jours ouvrés sans weekend

Re

La remarque de Modeste m'a fait prendre conscience que bien que reveillé et conscient, j'ai quand même le neurone chancelant

Sub CalendrierIV()
' Macro commise le 06/11/2012 par Staple au petit matin
Dim calend As Range, DDebut, i&
Application.ScreenUpdating = False
If IsEmpty([A7]) Then
DDebut = CDate(InputBox("Saisir une date", "Choix Date", "1/" & Month(Date) & "/" & Year(Date)))
If Weekday(DDebut, 2) = 6 Then DDebut = DDebut + 2
If Weekday(DDebut, 2) = 7 Then DDebut = DDebut + 1
If EstFerie(DDebut) Then DDebut = DDebut + 1
[A7] = DDebut
End If
Set calend = Range("A7:A372")
Range("A7").AutoFill Destination:=[calend], Type:=xlFillWeekdays
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

PS: Modeste: Quel différence entre l'autofill et Edition/Remplissage/Serie/Jours ouvrés ?

 

[C@thy]

Re : calendrier jours ouvrés sans weekend

Moi je le trouve pas si chancelant que ça ton neurone, Jean-Marie!...

Bises et merci

C@thy

 

[Staple1600]

Re : calendrier jours ouvrés sans weekend

Re

Non seulement il chancelle mais il fait dans le stupide
car enfin avec ceci:
Range("A7").AutoFill Destination:=[calend], Type:=xlFillWeekdays
il serait surprenant que la function estsd retourne vrai...
Donc dans le code précédent, cette partie du code aurait du être:

For i = Range("A65536").End(xlUp).Row To 7 Step -1
If EstFerie(Cells(i, "A")) Then
Cells(i, "a").Delete shift:=xlUp
End If
Next i

Psss... c'est pas beau à voir les dégâts des ans sur ma petite tête

 

[Modeste geedee]

Re : calendrier jours ouvrés sans weekend

Bonsour®

Quel différence entre l'autofill et Edition/Remplissage/Serie/Jours ouvrés ?

heu ???
remplissage et autofill sont les même termes en gaulois et rostbeef ...

c'est le parametre JourOuvré (xlWeekday=Jour de semaine) qui est important ..!


concernant ta remarque : pas réveillé...(sommes plusieurs ce matin !!!)
entre le moment ou j'ai lu le fil et celui ou j'ai envoyé ma réponse tardive.

- ou trouve-t-on dans le parametrage XLD la fréquence de rafraichissement des posts ???
- est-il possible d'etre notifié de l'arrivée de nouveaux posts sur le sujet alors que l'on est en train d'y répondre ?

 

[Staple1600]

Re : calendrier jours ouvrés sans weekend

Re


Modeste:
Ce que je voulais dire
C'est quelle est la différence entre:
Saisir une date dans une cellule puis clic-droit, faire une recopie vers le bas et choisir:
Incrémenter les jours ouvrés
et
Saisir une date dans une cellule puis Edition/Remplissage/Série/Jour ouvré

Car le code VBA généré n'est pas le même, mais le résultat est lui identique

Sub Macro()
'1er cas
    Selection.AutoFill Destination:=Range("A7:A10"), Type:=xlFillWeekdays
'2ème cas
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlWeekday, Step:=1, Trend:=False
End Sub

Quelle syntaxe privilégier au niveau rapidité d’exécution ?

 

[Modeste geedee]

Re : calendrier jours ouvrés sans weekend

Bonsour®

C'est quelle est la différence entre:
Saisir une date dans une cellule puis clic-droit, faire une recopie vers le bas et choisir:
Incrémenter les jours ouvrés
et
Saisir une date dans une cellule puis Edition/Remplissage/Série/Jour ouvré

Car le code VBA généré n'est pas le même, mais le résultat est lui identique

Sub Macro()
'1er cas
    Selection.AutoFill Destination:=Range("A7:A10"), Type:=xlFillWeekdays
'2ème cas
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlWeekday, Step:=1, Trend:=False
End Sub

Quelle syntaxe privilégier au niveau rapidité d’exécution ?

j'avoue honnetement ne pas savoir,
je n'arrive d'ailleurs pas à reproduire(enregistreur) le code du 1er cas (Excel 2007) ???

aurais-tu constaté une différence notable ?

Ces codes par ailleurs sont le reflets d'actions de feuille de calcul et trés souvent plus rapide que les boucles VBA( sauf arrays)

 

[Staple1600]

Re : calendrier jours ouvrés sans weekend

Re

Modeste
Je posais juste la question (histoire de passer le temps et de satisfaire ma curiosité)
La 1ere macro ne fonctionne pas sous 2007? (ici suis sur un pc sous 2003 et cela fonctionne)

Sub TestPourXL2K7ouXL2KXII()
'A tester seulement dans une vierge
Cells.Clear
[A1:B1] = Array(Date, Date)
'AutoFill
Range("A1").AutoFill [A1:A10], 6
'Remplissage
Range("B1:B10").DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
       xlWeekday, Step:=1, Trend:=False
End Sub

Si tu peux éclairer ma lanterne, ou une autre bonne âme qui s'égarerait ici , merci d'avance.

Sub version_courte()
Cells.Clear
[A1:B1] = Array(Date, Date)
'AutoFill court fonctionne
Range("A1").AutoFill [A1:A10], 6
'Remplissage
'ne fonctionne pas
Range("B1:B10").DataSeries xlColumns, xlChronological, xlWeekday, 1, False
'cela aurait pu mais non
Range("B1:B10").DataSeries 2, 3, 2, 1, False
'et définitivement ne veut rien savoir, et Excvel ne broche pourtant pas
[B1:B10].DataSeries 2, 3, 2, 1, False
'Why ?
End Sub

 

[C@thy]

Re : calendrier jours ouvrés sans weekend

concernant ta remarque : pas réveillé...(sommes plusieurs ce matin !!!)

Eh les gars, j'adore quand vous êtes nuls... je me demande juste comment ça doit être quand vous êtes excellents

Cela dit, pour moi il va falloir que ça fonctionne en 2010 (pas encore testé).

Bravo à vous tous et mille mercis,

C@thy

 

[C@thy]

Re : calendrier jours ouvrés sans weekend

Staple, concernant le #33,

Sub CalendrierIII()
Dim calend As Range, i&
Application.ScreenUpdating = False
If IsEmpty([A7]) Then [A7] = Now '"1/1/" & Year(Now)
Set calend = Range("A7:A372") 'soit 366 jours (cas des années bissextiles)
Range("A7").AutoFill Destination:=[calend], Type:=xlFillWeekdays 'xlFillDays
calend.NumberFormat = "ddd d/mm/yyyy"
For i = Range("A65536").End(xlUp).Row To 7 Step -1
If EstFerie(Cells(i, "A")) Then 'Or estWE(Cells(i, "A"))
Cells(i, "a").Delete shift:=xlUp
End If
Next i
End Sub

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
jf12 = DateValue("26/12/" & A) * 1 ' 26 décembre
If D = jf12 Then GoTo Fin
jf13 = jf2 - 3 * 1 ' vendredi saint
If D = jf13 Then GoTo Fin
Exit Function
Fin:
EstFerie = True
End Function
du coup
'Function estWE(D) As Boolean
'estWE = (Weekday(D, vbMonday) > 5)
'End Function
devient inutile (dommage, c'était fun cette fonction)

Sub Macro()
'1er cas
Selection.AutoFill Destination:=Range("A7:A10"), Type:=xlFillWeekdays
'2ème cas
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
xlWeekday, Step:=1, Trend:=False
End Sub

C'est intéressant cette différence de syntaxe, pour un même résultat...

Biz

C@thy

 

[Modeste geedee]

Re : calendrier jours ouvrés sans weekend

Bonsour®
petites corrections/simplifications pour la fonction estFerié :

Function EstFerie(D) As Boolean
 Dim A&, PAQ As Double
 A = Year(D)
 PAQ = Evaluate("round(date(" & A & ",4,mod(234-11*mod(" & A & ",19),30))/7,)*7-6")
 If D = DateSerial(A, 1, 1) Then GoTo Fin '----------------nouvel an
 If D = PAQ + 1 Then GoTo Fin '------------------------lundi Pâques
 If D = DateSerial(A, 5, 1) Then GoTo Fin ' -----------------1er mai
 If D = DateSerial(A, 5, 8) Then GoTo Fin '-----------------8 mai 45
 If D = PAQ + 38 Then GoTo Fin ' -------------------------ascension
 If D = PAQ + 50 Then GoTo Fin '--------------------lundi pentecote
 If D = DateSerial(A, 7, 14) Then GoTo Fin ' ---------------14 juillet
 If D = DateSerial(A, 8, 15) Then GoTo Fin '-------------assumption
 If D = DateSerial(A, 11, 1) Then GoTo Fin '---------------toussaint
 If D = DateSerial(A, 11, 11) Then GoTo Fin '------armistice 14-18
 If D = DateSerial(A, 12, 25) Then GoTo Fin ' ------------------Noël
 Exit Function
Fin:
    EstFerie = True
 End Function

 

[Staple1600]

Re : calendrier jours ouvrés sans weekend

Bonsoir à tous


Cathy:
Pour le #33, voir le #35 (ou s'inquiéter de la qualité de tes lunettes)
Néanmoins merci de ta sollicitude

Modeste: merci pour le toilettage
Pas d'idées concernant le #39 ?

 

[Modeste geedee]

Re : calendrier jours ouvrés sans weekend

Bonsour®

Je posais juste la question (histoire de passer le temps et de satisfaire ma curiosité)

Celui qui aime à apprendre est bien près du savoir.(Confucius ?)

Si tu peux éclairer ma lanterne, ou une autre bonne âme qui s'égarerait ici , merci d'avance.

Sub version_courte()
Cells.Clear
[A1:B1] = Array(Date, Date)
'AutoFill court fonctionne
Range("A1").AutoFill [A1:A10], 6
'Remplissage
'ne fonctionne pas
Range("B1:B10").DataSeries xlColumns, xlChronological, xlWeekday, 1, False
'cela aurait pu mais non
Range("B1:B10").DataSeries 2, 3, 2, 1, False
'et définitivement ne veut rien savoir, et Excvel ne broche pourtant pas
[B1:B10].DataSeries 2, 3, 2, 1, False
'Why ?
End Sub

[/QUOTE]

Cette méthode crée une série de données dans la plage spécifiée. Type de données Variant.
Syntaxe : expression.DataSeries(ColLigne,
Type, Date, Étape, Arrêter, Tendance)

lorsqu'on ne précise pas explicitement les noms des arguments
tout les arguments (valeurs) doivent etre expressément indiquéset dans l'ordre, fussent-ils omis ou nuls

illustration :

Sub agrafe()
Cells.Clear
 [A1:E1] = Array(Date, Date, Date, Date, Date)
Range("A1:A365").Select ' <=====adapter ici l'etendue de la plage
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
         xlWeekday, Step:=1, Trend:=False
 [B]'AutoFill court fonctionne
[/B] Range("B1").AutoFill [B1:B365], 6
 [B]'Remplissage '  fonctionne aussi
[/B] Range("C1:C365").DataSeries xlColumns, xlChronological, xlWeekday, 1, , False
 [B]'cela aurait pu mais OUI
[/B]Range("D1:D365").DataSeries 2, 3, 2, 1, , False
[B] 'et définitivement Excel veut bien savoir,
 [/B][E1:E365].DataSeries 2, 3, 2, 1, , False
 ' testé Excel 2007
 End Sub

 

[C@thy]

Re : calendrier jours ouvrés sans weekend

Vous êtes trop forts, les gars

Merci pour tout et Big bisous

Au plaisir...

C@thy