Re : Alimenter automatiquement un ComboBox avec des dates

Publié par Jean-Marcel le 03/08/2014 11:26:06
Bonjour
en attendant mieux la macro
Sub MiseEnGrasDesSamediEtDimancheEtFérié()
Dim Cell As Range
With Sheets("Feuil1")
MsgBox .Range(Cells(4, 5), Cells(4, Range("IV4").End(xlToLeft).Column)).Address
For Each Cell In .Range(Cells(4, 5), Cells(4, Range("IV4").End(xlToLeft).Column))


If Weekday(CDate(Cell)) = 1 Or Weekday(CDate(Cell)) = 7 Then
Cell.Interior.ColorIndex = 15
Else
Cell.Interior.ColorIndex = xlNone
End If
'Jour de l'an
If Cell = CDate("1/1/" & Year(Cell)) Then
Cell.Interior.ColorIndex = 15
'Paques
ElseIf Cell = CDate(Round(CDate((Day(Minute(Year(Cell) / 38) / 2 + 55) & "/4/" & Year(Cell))) / 7, 0) * 7 - 6) Then
Cell.Interior.ColorIndex = 15
'Lundi de paques
ElseIf Cell = CDate(Round(CDate((Day(Minute(Year(Cell) / 38) / 2 + 55) & "/4/" & Year(Cell))) / 7, 0) * 7 - 6) + 1 Then
Cell.Interior.ColorIndex = 15
'1 er mai
ElseIf Cell = CDate("1/5/" & Year(Cell)) Then
Cell.Interior.ColorIndex = 15
'Fète De La Victoire
ElseIf Cell = CDate("8/5/" & Year(Cell)) Then
Cell.Interior.ColorIndex = 15
'Ascension
ElseIf Cell = CDate(Round(CDate((Day(Minute(Year(Cell) / 38) / 2 + 55) & "/4/" & Year(Cell))) / 7, 0) * 7 - 6) + 39 Then
Cell.Interior.ColorIndex = 15
'Pentecote
ElseIf Cell = CDate(Round(CDate((Day(Minute(Year(Cell) / 38) / 2 + 55) & "/4/" & Year(Cell))) / 7, 0) * 7 - 6) + 49 Then
Cell.Interior.ColorIndex = 15
'Lundi de Pentecote
ElseIf Cell = CDate(Round(CDate((Day(Minute(Year(Cell) / 38) / 2 + 55) & "/4/" & Year(Cell))) / 7, 0) * 7 - 6) + 50 Then
Cell.Interior.ColorIndex = 15
'Fète nationnale
ElseIf Cell = CDate("14/7/" & Year(Cell)) Then
Cell.Interior.ColorIndex = 15
'Assomption
ElseIf Cell = CDate("15/8/" & Year(Cell)) Then
Cell.Interior.ColorIndex = 15
'Toussaint
ElseIf Cell = CDate("01/11/" & Year(Cell)) Then
Cell.Interior.ColorIndex = 15
'Armistice
ElseIf Cell = CDate("11/11/" & Year(Cell)) Then
Cell.Interior.ColorIndex = 15
'Noel
ElseIf Cell = CDate("25/12/" & Year(Cell)) Then
Cell.Interior.ColorIndex = 15
End If
Next
End With

End Sub

Ce message est de : http://excel.veriti.net/modules/newbb/viewtopic.php?post_id=453