Sub creerCalendrier()
Dim dec1 As Long
Dim date1 As Date
Dim date2 As Date
'Décallage
dec1 = 3
'****************************************************************************************************************
'Date du mois et année
date1 = #5/1/2020# 'on doit indiquer la date en format anglo-saxon
date2 = Format(date1, "dd/mm/yy") 'on transforme en format français
Date3 = DateAdd("m", dec1, date2) 'on ajoute le nombre de mois de dec1
date4 = Format(Date3, "MMMM yyyy") 'on met le format que l'on veut
dec2 = 2 + 2 + 9 * dec1 + 1
'dec 3 = pour obj
dec3 = dec2 + 5
'dec 4 pour bilan
dec4 = dec3 + 1
'dec 5 pour date lettre
dec5 = dec2
Cells(2, dec2) = date4
Cells(2, dec2).Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16777216
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'****************************************************************************************************************
' Obj et Bilan
Cells(2, dec3).Select
ActiveCell.FormulaR1C1 = "Obj"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(2, dec4).Select
ActiveCell.FormulaR1C1 = "Bilan"
Cells(2, dec4).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("R2").Select
'****************************************************************************************************************
'Lettre Jour du calendrier
Cells(4, dec2).Select
ActiveCell.FormulaR1C1 = "L"
Cells(4, dec2 + 1).Select
ActiveCell.FormulaR1C1 = "M"
Cells(4, dec2 + 2).Select
ActiveCell.FormulaR1C1 = "M"
Cells(4, dec2 + 3).Select
ActiveCell.FormulaR1C1 = "J"
Cells(4, dec2 + 4).Select
ActiveCell.FormulaR1C1 = "V"
Cells(4, dec2 + 5).Select
ActiveCell.FormulaR1C1 = "S"
Cells(4, dec2 + 6).Select
ActiveCell.FormulaR1C1 = "D"
Cells(4, dec2 + 7).Select
Cells(10, dec2).Select
ActiveCell.FormulaR1C1 = "L"
Cells(10, dec2 + 1).Select
ActiveCell.FormulaR1C1 = "M"
Cells(10, dec2 + 2).Select
ActiveCell.FormulaR1C1 = "M"
Cells(10, dec2 + 3).Select
ActiveCell.FormulaR1C1 = "J"
Cells(10, dec2 + 4).Select
ActiveCell.FormulaR1C1 = "V"
Cells(10, dec2 + 5).Select
ActiveCell.FormulaR1C1 = "S"
Cells(10, dec2 + 6).Select
ActiveCell.FormulaR1C1 = "D"
Cells(10, dec2 + 7).Select
Cells(16, dec2).Select
ActiveCell.FormulaR1C1 = "L"
Cells(16, dec2 + 1).Select
ActiveCell.FormulaR1C1 = "M"
Cells(16, dec2 + 2).Select
ActiveCell.FormulaR1C1 = "M"
Cells(16, dec2 + 3).Select
ActiveCell.FormulaR1C1 = "J"
Cells(16, dec2 + 4).Select
ActiveCell.FormulaR1C1 = "V"
Cells(16, dec2 + 5).Select
ActiveCell.FormulaR1C1 = "S"
Cells(16, dec2 + 6).Select
ActiveCell.FormulaR1C1 = "D"
Cells(16, dec2 + 7).Select
Cells(22, dec2).Select
ActiveCell.FormulaR1C1 = "L"
Cells(22, dec2 + 1).Select
ActiveCell.FormulaR1C1 = "M"
Cells(22, dec2 + 2).Select
ActiveCell.FormulaR1C1 = "M"
Cells(22, dec2 + 3).Select
ActiveCell.FormulaR1C1 = "J"
Cells(22, dec2 + 4).Select
ActiveCell.FormulaR1C1 = "V"
Cells(22, dec2 + 5).Select
ActiveCell.FormulaR1C1 = "S"
Cells(22, dec2 + 6).Select
ActiveCell.FormulaR1C1 = "D"
Cells(22, dec2 + 7).Select
Cells(28, dec2).Select
ActiveCell.FormulaR1C1 = "L"
Cells(28, dec2 + 1).Select
ActiveCell.FormulaR1C1 = "M"
Cells(28, dec2 + 2).Select
ActiveCell.FormulaR1C1 = "M"
Cells(28, dec2 + 3).Select
ActiveCell.FormulaR1C1 = "J"
Cells(28, dec2 + 4).Select
ActiveCell.FormulaR1C1 = "V"
Cells(28, dec2 + 5).Select
ActiveCell.FormulaR1C1 = "S"
Cells(28, dec2 + 6).Select
ActiveCell.FormulaR1C1 = "D"
Cells(28, dec2 + 7).Select
Cells(34, dec2).Select
ActiveCell.FormulaR1C1 = "L"
Cells(34, dec2 + 1).Select
ActiveCell.FormulaR1C1 = "M"
Cells(34, dec2 + 2).Select
ActiveCell.FormulaR1C1 = "M"
Cells(34, dec2 + 3).Select
ActiveCell.FormulaR1C1 = "J"
Cells(34, dec2 + 4).Select
ActiveCell.FormulaR1C1 = "V"
Cells(34, dec2 + 5).Select
ActiveCell.FormulaR1C1 = "S"
Cells(34, dec2 + 6).Select
ActiveCell.FormulaR1C1 = "D"
Cells(34, dec2 + 7).Select
'****************************************************************************************************************
'Tableau du calendrier
Dim cellule As Range
Range("E5:K8").Select
Selection.Offset(0, dec2 - 5).Select
For Each cellule In Selection
cellule.Borders.Weight = xlThin
Next
Selection.Offset(6, 0).Select
For Each cellule In Selection
cellule.Borders.Weight = xlThin
Next
Selection.Offset(6, 0).Select
For Each cellule In Selection
cellule.Borders.Weight = xlThin
Next
Selection.Offset(6, 0).Select
For Each cellule In Selection
cellule.Borders.Weight = xlThin
Next
Selection.Offset(6, 0).Select
For Each cellule In Selection
cellule.Borders.Weight = xlThin
Next
Selection.Offset(6, 0).Select
For Each cellule In Selection
cellule.Borders.Weight = xlThin
Next
'****************************************************************************************************************
'Mettre en gris la date
Range("E5:K5").Select
Selection.Offset(0, dec2 - 5).Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Selection.Offset(6, 0).Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Selection.Offset(6, 0).Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Selection.Offset(6, 0).Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Selection.Offset(6, 0).Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Selection.Offset(6, 0).Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
'****************************************************************************************************************
'Mettre la date dans la bonne case puis dans les cases suivante selon la même ligne
date4 = Format(Date3, "dddd")
If date4 = "lundi" Then
Cells(5, dec2) = Date3
Cells(5, dec2 + 1) = Date3 + 1
Cells(5, dec2 + 2) = Date3 + 2
Cells(5, dec2 + 3) = Date3 + 3
Cells(5, dec2 + 4) = Date3 + 4
Cells(5, dec2 + 5) = Date3 + 5
Cells(5, dec2 + 6) = Date3 + 6
End If
If date4 = "mardi" Then
Cells(5, dec2 + 1) = Date3
Cells(5, dec2 + 2) = Date3 + 1
Cells(5, dec2 + 3) = Date3 + 2
Cells(5, dec2 + 4) = Date3 + 3
Cells(5, dec2 + 5) = Date3 + 4
Cells(5, dec2 + 6) = Date3 + 5
End If
If date4 = "mercredi" Then
Cells(5, dec2 + 2) = Date3
Cells(5, dec2 + 3) = Date3 + 1
Cells(5, dec2 + 4) = Date3 + 2
Cells(5, dec2 + 5) = Date3 + 3
Cells(5, dec2 + 6) = Date3 + 4
End If
If date4 = "jeudi" Then
Cells(5, dec2 + 3) = Date3
Cells(5, dec2 + 4) = Date3 + 1
Cells(5, dec2 + 5) = Date3 + 2
Cells(5, dec2 + 6) = Date3 + 3
End If
If date4 = "vendredi" Then
Cells(5, dec2 + 4) = Date3
Cells(5, dec2 + 5) = Date3 + 1
Cells(5, dec2 + 6) = Date3 + 2
End If
If date4 = "samedi" Then
Cells(5, dec2 + 5) = Date3
Cells(5, dec2 + 6) = Date3 + 1
End If
If date4 = "dimanche" Then Cells(5, dec2 + 6) = Date3
'****************************************************************************************************************
'Mettre la date dans toutes les cases
'Recupérer la dernière date de la ligne
Cells(11, dec2) = Cells(5, dec2 + 6) + 1
Cells(11, dec2 + 1) = Cells(5, dec2 + 6) + 2
Cells(11, dec2 + 2) = Cells(5, dec2 + 6) + 3
Cells(11, dec2 + 3) = Cells(5, dec2 + 6) + 4
Cells(11, dec2 + 4) = Cells(5, dec2 + 6) + 5
Cells(11, dec2 + 5) = Cells(5, dec2 + 6) + 6
Cells(11, dec2 + 6) = Cells(5, dec2 + 6) + 7
Cells(17, dec2) = Cells(11, dec2 + 6) + 1
Cells(17, dec2 + 1) = Cells(11, dec2 + 6) + 2
Cells(17, dec2 + 2) = Cells(11, dec2 + 6) + 3
Cells(17, dec2 + 3) = Cells(11, dec2 + 6) + 4
Cells(17, dec2 + 4) = Cells(11, dec2 + 6) + 5
Cells(17, dec2 + 5) = Cells(11, dec2 + 6) + 6
Cells(17, dec2 + 6) = Cells(11, dec2 + 6) + 7
Cells(23, dec2) = Cells(17, dec2 + 6) + 1
Cells(23, dec2 + 1) = Cells(17, dec2 + 6) + 2
Cells(23, dec2 + 2) = Cells(17, dec2 + 6) + 3
Cells(23, dec2 + 3) = Cells(17, dec2 + 6) + 4
Cells(23, dec2 + 4) = Cells(17, dec2 + 6) + 5
Cells(23, dec2 + 5) = Cells(17, dec2 + 6) + 6
Cells(23, dec2 + 6) = Cells(17, dec2 + 6) + 7
JourFinMois = DateSerial(Year(Cells(23, dec2 + 6)), Month(Cells(23, dec2 + 6)) + 1, 1) - 1
If Cells(23, dec2 + 6) < JourFinMois Then Cells(29, dec2) = Cells(23, dec2 + 6) + 1
If Cells(23, dec2 + 6) + 1 < JourFinMois Then Cells(29, dec2 + 1) = Cells(23, dec2 + 6) + 2
If Cells(23, dec2 + 6) + 2 < JourFinMois Then Cells(29, dec2 + 2) = Cells(23, dec2 + 6) + 3
If Cells(23, dec2 + 6) + 3 < JourFinMois Then Cells(29, dec2 + 3) = Cells(23, dec2 + 6) + 4
If Cells(23, dec2 + 6) + 4 < JourFinMois Then Cells(29, dec2 + 4) = Cells(23, dec2 + 6) + 5
If Cells(23, dec2 + 6) + 5 < JourFinMois Then Cells(29, dec2 + 5) = Cells(23, dec2 + 6) + 6
If Cells(23, dec2 + 6) + 6 < JourFinMois Then Cells(29, dec2 + 6) = Cells(23, dec2 + 6) + 7
If Cells(23, dec2 + 6) + 7 < JourFinMois Then Cells(35, dec2) = Cells(29, dec2 + 6) + 1
If Cells(23, dec2 + 6) + 7 + 1 < JourFinMois Then Cells(35, dec2 + 1) = Cells(29, dec2 + 6) + 2
If Cells(23, dec2 + 6) + 7 + 2 < JourFinMois Then Cells(35, dec2 + 2) = Cells(29, dec2 + 6) + 3
If Cells(23, dec2 + 6) + 7 + 3 < JourFinMois Then Cells(35, dec2 + 3) = Cells(29, dec2 + 6) + 4
If Cells(23, dec2 + 6) + 7 + 4 < JourFinMois Then Cells(35, dec2 + 4) = Cells(29, dec2 + 6) + 5
If Cells(23, dec2 + 6) + 7 + 5 < JourFinMois Then Cells(35, dec2 + 5) = Cells(29, dec2 + 6) + 6
If Cells(23, dec2 + 6) + 7 + 6 < JourFinMois Then Cells(35, dec2 + 6) = Cells(29, dec2 + 6) + 7
Range("A1").Select
'****************************************************************************************************************
'Supprimer les cellules non utilisées du calendrier
For b = 1 To 40
If Cells(5, b) = "" Then
Cells(4, b).Clear
Cells(5, b).Clear
Cells(6, b).Clear
Cells(7, b).Clear
Cells(8, b).Clear
End If
Next
For b = 1 To 40
If Cells(29, b) = "" Then
Cells(28, b).Clear
Cells(29, b).Clear
Cells(30, b).Clear
Cells(31, b).Clear
Cells(32, b).Clear
End If
Next
For b = 1 To 40
If Cells(35, b) = "" Then
Cells(34, b).Clear
Cells(35, b).Clear
Cells(36, b).Clear
Cells(37, b).Clear
Cells(38, b).Clear
End If
Next
'Remise en forme
Range("5:5,11:11,17:17,23:23,29:29,35:35").Select
Range("A29").Activate
ActiveWindow.SmallScroll Down:=0
Selection.NumberFormat = "dd/mm"
Columns("C:BZ").Select
Selection.ColumnWidth = 5
Range("A1").Select
End Sub