1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
| Application.ScreenUpdating = False
Dim Col As Integer, Colon As Integer, DerCol As Integer, Dcol As Integer, Mois As Variant, FinMois As Variant
Dim Date_Test As Date, Date_Mois_Suivant As Date, Dernier_Jour_Mois As Date, Nbre_Jour As Integer
Dim CA As Range, Nb As Integer, Target As Range
With Range("F5:ZZ6")
.Value = ""
.MergeCells = False
.Interior.ThemeColor = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
Dcol = Cells(10, Cells.Columns.Count).End(xlToLeft).Column
Col = 6
While Col <= Dcol
If Cells(11, Col) <> "" Then
'Une date de la cellule
Date_Test = CDate(Cells(11, Col))
'Mois / année de la date
Mois = Month(Date_Test)
Annee = Year(Date_Test)
'Calcul du premier jour du mois suivant
Date_Mois_Suivant = DateSerial(Annee, Mois + 1, 1)
'Date du dernier jour
Dernier_Jour_Mois = Date_Mois_Suivant - 1
'Nombre de jour dans le mois (= dernier jour)
Nbre_Jour = Day(Dernier_Jour_Mois) - Day(Cells(11, Col))
MsgBox Dernier_Jour_Mois & Chr(10) & Cells(10, Col + Nbre_Jour)
Colon = Col + Nbre_Jour
MsgBox Colon
End If
MsgBox Mois
MsgBox Col
Range(Cells(5, Col), Cells(6, Colon)).Select
With Selection
.MergeCells = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.FormulaR1C1 = "=EDATE(R[6]C,0)"
.NumberFormat = "mmmm"
.Font.Size = 14
.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Col = Col + Colon - 5
Wend
Range("C3:E7").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
Application.ScreenUpdating = True |
Partager