Sub Actualiser_Planning() 'valider
'/!\ Attention! Il faut supprimer la 1ère colonne Nom, la ligne des dates doit débuter en A5
Dim RngDate As Range, rng As Range, col1 As Integer, col2 As Integer, LigFeuil As Integer
Dim colfeuil As Integer, i As Integer, x As Byte, couleur As Byte, lig As Long
Dim plage As Range, DateDebut As Long, derlig1 As Long, derlig2 As Long, DateFin As Long
Dim Tb()
Tb = [tbres].Value
With Sheets("PLANNING RESERVATIONS")
.Activate
LigFeuil = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).row
colfeuil = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column
Set RngDate = .Range(.Cells(5, 1), .Cells(5, colfeuil))
If LigFeuil > 5 Then
Set rng = .Range(.Cells(6, 1), .Cells(LigFeuil, colfeuil))
rng.Clear
End If
couleur = 3
For i = 1 To UBound(Tb)
DateDebut = CLng(Tb(i, 3))
DateFin = CLng(Tb(i, 4))
col1 = Application.Match(DateDebut, RngDate, 0)
col2 = Application.Match(DateFin, RngDate, 0)
'verifie dernier ligne vide ou non de la colonne trouvée
derlig1 = .Cells(Rows.Count, col1).End(xlUp).row + 1
derlig2 = .Cells(Rows.Count, col2).End(xlUp).row + 1
If derlig1 = derlig2 Then
Set plage = .Range(Cells(derlig1, col1), Cells(derlig2, col2))
x = Application.WorksheetFunction.CountA(plage)
If x = 0 Then
plage.Value = Tb(i, 5) & " " & Tb(i, 6)
plage.Interior.ColorIndex = couleur
End If
Else
lig = IIf(derlig1 > derlig2, derlig1, derlig2)
Set plage = .Range(Cells(lig, col1), Cells(lig, col2))
x = Application.WorksheetFunction.CountA(plage)
If x = 0 Then
plage = Tb(i, 5) & " " & Tb(i, 6)
plage.Interior.ColorIndex = couleur
Else
Set plage = plage.Offset(1)
plage = Tb(i, 5) & " " & Tb(i, 6)
plage.Interior.ColorIndex = couleur
End If
End If
If couleur = 11 Or couleur = 25 Or couleur = 5 Or couleur = 9 Then
plage.Font.ColorIndex = 2
Else
plage.Font.ColorIndex = 1
End If
plage.Font.Bold = True
couleur = couleur + 1
If couleur > 56 Then couleur = 3 '56 limite de colorindex
Next i
.Range("a5").CurrentRegion.Borders.Weight = xlThin
.Range("a5").CurrentRegion.Columns.AutoFit
End With
MsgBox "Planning Actualisé!", vbInformation + vbOKOnly, "Actualisation"
End Sub