Sur le site de Frédéric, CalendrierJoursDeTravail_CFroeliger.zip http://perso.wanadoo.fr/frederic.sigonneau/
ou directement: http://perso.wanadoo.fr/frederic.sigonneau/code/Calendriers/CalendrierJoursD eTravail_CFroeliger.zip
ChrisV
"pat" a écrit dans le message de news: 40008904$0$17128$
dans un tableau je veux mettre tous les jours ouvrés de chaque mois pour 2004.Comment faire ? merci Patrick
AV
Avec un XL français : (attention aux retours à la lignes intempestifs !)
Sub zz_Calendrier() 'av an = Val(InputBox("Année ?", "CALENDRIER", Year(Date))) If an = "" Then Exit Sub Application.ScreenUpdating = False [A1].CurrentRegion.ClearContents col = 1: lg = 1 If an = 0 Or an > 9998 Or an < 1901 Then [A2:L32].FormatConditions.Delete Exit Sub End If x = DateSerial(an, 1, 1) y = DateSerial(an, 12, 31) For i = 0 To y - x lg = lg + 1: Cells(lg, col) = x + i If x + i = DateSerial(Year(x + i), Month(x + i) + 1, 1) - 1 Then col = col + 1: lg = 1 Next [A1:L1] = "=upper(text(""01/""&column(),""mmmm""))" [A1:L1] = [A1:L1].Value [A2].CurrentRegion.NumberFormat = "ddd dd/mm/yy" Cells.EntireColumn.AutoFit
[A2:L32].Select With Selection .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ou(et(jour(a2)=1;mois(a2)=1);franc(date(annee(a2);4;jour(minute(annee(a2)/38)/ 2+55))/7;)*7-6+1¢;et(jour(a2)=1;mois(a2)=5);et(jour(a2)=8;mois(a2)=5);franc(da te(annee(a2);4;jour(minute(annee(a2)/38)/2+55))/7;)*7-6+39¢)" .FormatConditions(1).Interior.ColorIndex = 34 If an > 2004 Then .FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ou(franc(date(annee(a2);4;jour(minute(annee(a2)/38)/2+55))/7;)*7-6+50¢;et(jo ur(a2);mois(a2)=7);et(jour(a2);mois(a2)=8);et(jour(a2)=1;mois(a2));et(j our(a2);mois(a2));et(jour(a2)%;mois(a2)))" End If .FormatConditions(2).Interior.ColorIndex = 34 .FormatConditions.Add Type:=xlExpression, Formula1:= _ "=joursem(a2;2)>5" .FormatConditions(3).Interior.ColorIndex = 27 .NumberFormat = "ddd dd/mm/yy" .HorizontalAlignment = xlLeft End With
[A1].CurrentRegion.SpecialCells(xlCellTypeBlanks).FormatConditions.Delete [A1].Select End Sub
AV
Avec un XL français :
(attention aux retours à la lignes intempestifs !)
Sub zz_Calendrier() 'av
an = Val(InputBox("Année ?", "CALENDRIER", Year(Date)))
If an = "" Then Exit Sub
Application.ScreenUpdating = False
[A1].CurrentRegion.ClearContents
col = 1: lg = 1
If an = 0 Or an > 9998 Or an < 1901 Then
[A2:L32].FormatConditions.Delete
Exit Sub
End If
x = DateSerial(an, 1, 1)
y = DateSerial(an, 12, 31)
For i = 0 To y - x
lg = lg + 1: Cells(lg, col) = x + i
If x + i = DateSerial(Year(x + i), Month(x + i) + 1, 1) - 1 Then col = col
+ 1: lg = 1
Next
[A1:L1] = "=upper(text(""01/""&column(),""mmmm""))"
[A1:L1] = [A1:L1].Value
[A2].CurrentRegion.NumberFormat = "ddd dd/mm/yy"
Cells.EntireColumn.AutoFit
[A2:L32].Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ou(et(jour(a2)=1;mois(a2)=1);franc(date(annee(a2);4;jour(minute(annee(a2)/38)/
2+55))/7;)*7-6+1¢;et(jour(a2)=1;mois(a2)=5);et(jour(a2)=8;mois(a2)=5);franc(da
te(annee(a2);4;jour(minute(annee(a2)/38)/2+55))/7;)*7-6+39¢)"
.FormatConditions(1).Interior.ColorIndex = 34
If an > 2004 Then
.FormatConditions.Add Type:=xlExpression, Formula1:= _
Avec un XL français : (attention aux retours à la lignes intempestifs !)
Sub zz_Calendrier() 'av an = Val(InputBox("Année ?", "CALENDRIER", Year(Date))) If an = "" Then Exit Sub Application.ScreenUpdating = False [A1].CurrentRegion.ClearContents col = 1: lg = 1 If an = 0 Or an > 9998 Or an < 1901 Then [A2:L32].FormatConditions.Delete Exit Sub End If x = DateSerial(an, 1, 1) y = DateSerial(an, 12, 31) For i = 0 To y - x lg = lg + 1: Cells(lg, col) = x + i If x + i = DateSerial(Year(x + i), Month(x + i) + 1, 1) - 1 Then col = col + 1: lg = 1 Next [A1:L1] = "=upper(text(""01/""&column(),""mmmm""))" [A1:L1] = [A1:L1].Value [A2].CurrentRegion.NumberFormat = "ddd dd/mm/yy" Cells.EntireColumn.AutoFit
[A2:L32].Select With Selection .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ou(et(jour(a2)=1;mois(a2)=1);franc(date(annee(a2);4;jour(minute(annee(a2)/38)/ 2+55))/7;)*7-6+1¢;et(jour(a2)=1;mois(a2)=5);et(jour(a2)=8;mois(a2)=5);franc(da te(annee(a2);4;jour(minute(annee(a2)/38)/2+55))/7;)*7-6+39¢)" .FormatConditions(1).Interior.ColorIndex = 34 If an > 2004 Then .FormatConditions.Add Type:=xlExpression, Formula1:= _
