Microsoft 365 Code incomplet

Marvin57 à dit:

@cp4

j'ai beau essayé mais cela ne fonctionne pas si je supprime la ligne
With Sheets("planning reservations") et le end with.

Par contre si je change en
With Sheets("Listing reservations"), tout va bien.

Ce que tu m'as dis tout à l'heure je ne l'ai pas compris .

Cliquez pour agrandir...

cp4 à dit:

Sur la feuille LISTING RESERVATIONS, il y a un tableau structuré que j'ai renommé TbRes
Ensuite dans useform_initialize, j'ai chargé dans une variable tableau TbData = [tbres].Value
Tbdata a été déclaré en haut du module pour pouvoir le réutiliser dans la procédure de filtrage de la listbox.

Je ne comprends pas chez moi ça fonctionne. Honnêtement, je n'ai pas beaucoup testé.
Le code fonctionnait même avec ma grossière erreur.

Bonne soirée.

Cliquez pour agrandir...

cp4 à dit:

Bonjour,

@Marvin57 : Code à copier dans un module standard. Ensuite l'appeler à partir de l'évènement Activate de la feuille PLANNING RESERVATIONS. Clic-droit sur l'onglet, visualiser le code et tu colles les lignes ci-dessous

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Actualiser_Planning
End Sub

Dans module standard ci-dessous

Code:

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

Faire un retour.

A Lundi ou Mardi

Edit: Code modifier

Cliquez pour agrandir...