XL 2016 Gestion de liste de courses pour sejour de groupe

[Arno_1111]

Bonjour,

Dans le cadre de mes activités de groupe extra-prefessionnelles, je cherche à gérer un fichier qui me permette d'établir un liste de course à partir d'un contenu pre-existant de menus, mais qui devra s'adapter au nombre de personne, au nombre de jours, ....

Nombre de personnes à bord 7
Nombre de jours 5

--> Création d'un tableau de n lignes (nb jours, n colonnes (petit-dej, dej, diner)
--> pour chaque case dej, diner: choix dans un menu déroulant des listes de recettes connues
--> en fonction de ces choix, on gère ensuite les qtés nécessaires, …

Il existe dans le fichier
- une liste de menus (sommaire)
- une liste de qté par personne en fonction des aliments

Le but étant de faire une combinaison de toutes ces informations.

Auriez-vous des suggestions à me proposer (voir brouillon de fichier en attachement) ?

Merci pour votre aide.

Arnaud

 

[AtTheOne]

Bonjour à tous & à toutes, bonjour @Arno_1111
Ta demande n'a pas passionner les foules ...
Si c'est encore d'actualité je te fais une proposition :

Un classeur avec 4 onglets plus un mémo

• Onglet Accueil : permet de définir le nombre de personnes, de jours et un nom attribué au séjour.
  un clic sur l'invite crée un onglet pour le séjour.
• Onglet Tables : avec en particulier un tableau des quantités par personne pour les ingrédients, les unités utilisées, pour chaque type de plat (entrée, salade composée, plat principal, dessert)
• Onglet Recettes : permet de définir les recettes, Nom de la recette, type de plat, et par clic droit dans la colonne Ingrédientn de choisir jusqu"à 20 ingrédients pour la recette.
  Les unités et quantités par personne sont renseignées (lecture de l'onglet Table), on peut ajuster les quantités pour coller à la recette.
• Onglet Modèle Séjour : Onglet masqué, sert de modèle pour les nouveaux séjours

Dans l'onglet créé pour le séjour, les colonnes des déjeuners et dîners permettent de choisir les plats (choix dans liste).
A chaque modification d'un plat, la liste d'avitaillement pour le séjour est mise à jour en tenant compte du nombre de personnes. Les quantités pour les ingrédients à la pièce sont arrondis à l'unité supérieure.
L'onglet mémo reprend ces informations.

Ce projet est améliorable en prévoyant des menus (entrée, plat, dessert) pour les repas au lieu de simple plat et en ajoutant des éléments comme le pain, le beurre, le sel etc. mais c'est une première proposition en attendant ton retour.

Code de l'onglet "Accueil"

Private Sub Worksheet_Change(ByVal Target As Range)
    
     Select Case True
          Case Target.Address = [nom_Séjour].Address
               If IsEmpty([nb_Personnes]) Or IsEmpty([nb_Jours]) Then
                    MsgBox "Remplir le nombre de personnes et le nombre de jours avant de nommer le séjour."
                    Exit Sub
               End If
               Application.EnableEvents = False
               Txt = Target.Text
               If Not [contrôle_Nom_Séjour] Then  'Nom défini qui teste la validité de nom du séjour
                    Application.Undo
                    'vérifier la validité du nom de séjour (avant de créer la feuille)
                    Select Case True
                         Case Len(Txt) = 0 Or Len(Txt) > 24 '(31c -7c)
                              MsgBox Prompt:=Txt & Chr(10) & "Nombre de caractères incorrect !", Title:="-----Nom du séjour-----"
                         Case Else
                              MsgBox Prompt:=Txt & Chr(10) & "Caractère interdit !", Title:="-----Nom du séjour-----"
                    End Select
                    Application.EnableEvents = True: Exit Sub
               End If
              
               'Voir si un séjour du même nom existe déjà
               On Error Resume Next
               Set WSh = Nothing
               Set WSh = ThisWorkbook.Worksheets("Séjour " & Txt)
               On Error GoTo 0
               If Not WSh Is Nothing Then
                    Application.Undo
                    MsgBox Prompt:="Un séjour nommé" & Chr(10) & Chr(9) & """" & Txt & """" & Chr(10) & "existe déjà !", _
                           Title:="-----Nom du séjour-----"
                    Application.EnableEvents = True: Exit Sub
               End If
              
     End Select
     Application.EnableEvents = True
End Sub

Code de l'onglet Recettes

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    
     If Intersect(ActiveCell, [tb_Recettes]) Is Nothing Then Exit Sub
    
     typCol = Intersect(ActiveCell.EntireColumn, [tb_Recettes].ListObject.HeaderRowRange)
     If Not typCol Like "Ingrédient*" Then Exit Sub
    
     Cancel = True
     Set Cible = ActiveCell
    
     If Intersect([tb_Recettes[Type de plat]], Cible.EntireRow) = "" Then MsgBox "Renseigez d'abord le type de plat.": Exit Sub
     UsF_choix_Ingrédients.Show
    
End Sub

Code des onglets Séjour

Private Sub Worksheet_Change(ByVal Target As Range)

     Dim dico As Object
     Set dico = CreateObject("Scripting.Dictionary")
     Lo = Me.ListObjects(1).Name
    
     If Target.CountLarge > 1 Or Intersect(Evaluate(Lo), Target) Is Nothing Then Exit Sub
    
     Plats = Evaluate(Lo & "[[Déjeuner]:[Dîner]]")     'colonnes Déjeuner et diner
     Recettes = [tb_Recettes]                          'tableau des recettes
    
     'composer un dictionnaire des ingrédients utilisés pour le séjour
     For i = 1 To UBound(Plats, 1): For j = 1 To UBound(Plats, 2) 'on parcourt tous les repas
          Plat = Plats(i, j)
          If Plat <> "" Then       'si le plat de ce repas est défini
               With WorksheetFunction
                    idx = .Match(Plat, .Index(Recettes, 0, 1), 0)     'type de plat pour lire la quantité/Pers pour les ingrédients
                    For h = 0 To 19     'pour chaque ingrédient possible
                         col = 3 + h * 3     'colonne ingrédient
                         ingrédient = Recettes(idx, col): unité = Recettes(idx, col + 2): qté = Recettes(idx, col + 1)
                         If ingrédient <> "" Then      'si cet ingrédient est défini en incrémenter la qté
                              'la clé du dico est la concaténation de l'ingrédient et de l'unité utilisée
                              dico(ingrédient & "¤" & unité) = dico(ingrédient & "¤" & unité) + qté
                         End If
                    Next
               End With
          End If
     Next j: Next i
    
     nb = dico.Count               'nb d'ingrédients trouvés
     Lo = Me.ListObjects(2).Name   'nom du tableau d'avitaillement
     Set LObj = Me.ListObjects(Lo)
    
     Application.EnableEvents = False
     Application.ScreenUpdating = False
     Evaluate(Lo).ClearContents         'RàZ du tableau d'avitaillement
    
     If nb > 0 Then
          nbPers = Me.[nb_Personnes]         'pour la quantité pour le nb de personnes
          tb1 = dico.keys: tb2 = dico.Items  'les infos du dico dans des tableaux,tb1 : les clés, tb2 les quantités
          ReDim ingrédients(1 To nb, 1 To 3) 'dimensionnement du tableau résultat (nb ingrédients; nom, qté, unité)
          
          For i = 1 To nb                    'remplissage du tableau
               Txt = Split(tb1(i - 1), "¤")  'découper la clé 0 : nom de l'ingrédient, 1 : unité utilisée
               ingrédients(i, 1) = Txt(0): ingrédients(i, 2) = Txt(1): ingrédients(i, 3) = tb2(i - 1) * nbPers
               If ingrédients(i, 2) = "pièce" Then ingrédients(i, 3) = WorksheetFunction.Ceiling(ingrédients(i, 3), 1)
          Next i
          'redimensionner le tableau structuré, et le remplir
          With LObj
               .Resize .Range.Resize(nb + 1)
               .DataBodyRange.Value = ingrédients
               With .Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=LObj.ListColumns(1).DataBodyRange, SortOn:=xlSortOnValues, Order:=xlAscending
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .Apply
               End With
          End With
     Else
          'tableau structuré vide
          With LObj
               .Resize .Range.Resize(2)
          End With
     End If
    
     Application.ScreenUpdating = True
     Application.EnableEvents = True
    
End Sub

Macro Nouveau_Séjour

Public Cible As Range

Sub Nouveau_Séjour()
    
     Dim WSh As Worksheet, Lo As ListObject, AdrRg$, Nom$, nbJours%, nbPersonnes%
    
     Nom = [nom_Séjour]
     nbJours = [nb_Jours]
     nbPersonnes = [nb_Personnes]
    
     If nbJours < 1 Or nbPersonnes < 1 Then
          MsgBox Prompt:="Remplissez d'abord le nombre de jours et le nombres de personnes !", Title:="Séjour """ & Nom & """": Exit Sub
     End If
      
     If Nom = "" Then
          MsgBox Prompt:="Attribuez d'abord un nom au séjour !", Title:="Séjour": Exit Sub
     End If
    
     sh_Modèle_Séjour.Copy After:=Sh_Accueil
     Set WSh = ThisWorkbook.Worksheets(Sh_Accueil.Index + 1)
     WSh.Name = "Séjour " & Nom
     WSh.Visible = True
    
     For Each Nm In WSh.Names
          Nm.Delete
     Next
     AdrRg = sh_Modèle_Séjour.Names("Nb_Personnes_à_bord").RefersToRange.Address
     WSh.Names.Add Name:="Nb_Personnes_à_bord", RefersTo:=WSh.Range(AdrRg)
     WSh.[Nb_Personnes_à_bord].Value = nbPersonnes
     WSh.Activate
     ActiveWindow.DisplayGridlines = False

     Nom_Tableau = "tb_" & Replace(Replace(Replace(Replace(Replace("Séjour " & Nom, "-", "_"), " ", "_"), "-", "¤"), "+", "¤"), """", "")
     Set Lo = WSh.ListObjects(1)
     Lo.Name = Nom_Tableau
     Lo.Resize Lo.Range.Resize(nbJours + 1)
     With Lo.ListColumns(1).DataBodyRange
          For i = 1 To nbJours
               .Cells(i) = i
          Next
     End With
    
     Nom_Tableau = "tb_" & Replace(Replace(Replace(Replace(Replace("Avitaillement " & Nom, "-", "_"), " ", "_"), "-", "¤"), "+", "¤"), """", "")
     Set Lo = WSh.ListObjects(2)
     Lo.Name = Nom_Tableau

     Application.EnableEvents = False: [nom_Séjour].ClearContents: Application.EnableEvents = True
End Sub

Voir le fichier joint