Microsoft 365 Code incomplet

M

Marvin57

XLDnaute Occasionnel
Bonjour à tout le monde,

j'ai récupéré un fichier qui pourrait m'aider, mais je n'arrive pas à mettre en place les codes .

Il contient des codes que j'ai réussi à modifier, mais je n'arrive pas à adapter les deux codes suivants: " Actualiser_Planning_Reservations" et le code " SupprPlanningReservations ".
Je pense que dans ces deux codes il y a des instructions manquantes !

Pour vous donner une explication du fonctionnement du fichier;

En appelant le UserForm " DEMANDE_RESERVATIONS " (en cliquant sur le bouton " Saisir une réservation") , je veux pouvoir saisir le nom de client, le nombre de jours dans le textbox5 et suite à la saisie de ce nombre de jour dans ce textbox et la saisie de la date d'arrivée choisie, il me renseignera la date de départ.

Une fois que cela fonctionne, il faudrait également pouvoir modifier des lignes si nécessaire en cliquant sur le client voulu dans la listbox1 et une fois les infos modifiées je pourrai cliquer sur le bouton modifier.

Pour l'instant je vous laisse regarder et si besoin vous me dites si quelque chose est mal expliqué s'il vous plaît.

Merci à vous en attendant.

Marvin57
 

Pièces jointes

  • MARVIN57 PLANNING RESERVATIONS.xlsm
    94.7 KB · Affichages: 6
Solution
cp4
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...
Trier par date Trier par votes
cp4

cp4

XLDnaute Barbatruc
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...
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.
 
Vote positif 0 Vote négatif
M

Marvin57

XLDnaute Occasionnel
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...
Re,

T'inquiètes pas, je vais faire plusieurs essais et je devrai y arriver aussi, enfin, on verra.
Je te tiendrai informé demain.
En attendant Merci à toi et bonne soirée.
A+
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
M

Marvin57

XLDnaute Occasionnel
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...
Bonjour cp4,

pour donner suite à mon fichier.

Après réflexion et après avoir testé plusieurs choses, je vais faire simple.

Je vais garder juste l'onglet LISTING RESERVATIONS, cela me suffira et me donnera toutes les infos utiles.
Le calendrie comme il était sur l'onglet PLANNING RESERVATIONS était bienc'est sûr, mais ne rapporte pas de plus.

En tout cas MERCI beaucoup pour ton travail et le temps passé sur ma demande.👍👍

Je te dis à une prochaine fois, certainement.

Cordialement, Marvin57
 
Vote positif 0 Vote négatif

Discussions similaires

Z
  • Question
XL 2021 InputBox and focus à la fin de la ligne d'une valeur par défaut
Réponses
4
Affichages
270
zedude
Z
B
  • Question
Microsoft 365 contrôler un EXIT
Réponses
2
Affichages
91
Bill73
B
T
  • Résolu(e)
Microsoft 365 Correction Code VBA
Réponses
10
Affichages
360
Thomi
T
jeff1494
  • Question
XL 2021 Saisie de lignes multiples dans un formulaire
2
Réponses
15
Affichages
646
jeff1494
jeff1494
A
  • Résolu(e)
XL 2021 Incrémentation auto
Réponses
6
Affichages
284
AngieMot33
A
T
  • Résolu(e)
Saisie Userform pour base de données
2
Réponses
24
Affichages
2 K
TAL
T
N
  • Résolu(e)
Microsoft 365 Aide pour terminer un code Vba Excel
2
Réponses
23
Affichages
995
job75
job75
T
  • Question
XL pour MAC Formule matricielle
Réponses
10
Affichages
501
crocrocro
C
P
  • Question
Microsoft 365 Créer un formulaire qui affiche le contenu modifiable d'une plage de cellules
Réponses
5
Affichages
605
sousou
sousou
R
  • Question
Microsoft 365 VBA Excel PowerPoint
Réponses
5
Affichages
273
Rem6610
R

Membres actuellement en ligne

16 membres et 249 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 118
Messages
2 116 419
Membres
112 744
dernier inscrit
pat38070