Remplissage du cbNomDessert

Bonsoir à toutes et ç tous,

ATTENTION :JE NE DEMANDE PAS QU'ON ME CRÉE UN NOUVEAU FICHIER, UN NOUVEAU PROGRAMME MAIS QU'ON M'AIDE À TROUVER LA SOLUTION DU PROBLÈME CITÉ DANS LE TITRE DU SUJET;

Je n'arrive pas à trouver la solution pour faire apparaître la liste dessert midi retraite (un seul item) dans le cbNomDessert en utilisant, si possible, dictionary. D'avance merci pour votre aide. Peut-être manque-t-il des instructions dans une ou plusieurs procédures (déjà créées ou à créer).

Personnellement, je pense que l'envoi d'un fichier est plus explicite que de joindre un extrait d'instructions, lequel extrait risque de ne pas pouvoir voir ce qui risque de manquer.

Bonjour BUDGETS, le forum,

Au bas de la macro Private Sub tbDateCréationArticlesMenus_Change() , il y a Select Case tbCodeNatureArticlesMenus.Value

Mais en fait, il faut lire dans Select Case tbCodeNatureCréation.Value

Pour avoir le code "MMR".

Dès lors, ça fonctionne.

Bastr

Bonsoir Bastr,

Merci d'avoir répondu et de me proposer une solution. Je vais essayer cela demain car aujourd'hui, j'ai fait mon temps imparti pour travailler sur l'ordinateur.

Bonnes soirée, nuit et continuation. Prenez bien soin de vous.

Bonjour BUDGETS, le forum,

Désolé pour ma méprise, j'ai oublié les autres modifications; il y en a quatre.

CTRL+F et recherche : modif_Bastr afin de trouver les quatre endroits où il y a eu changement.

J'ai revérifié et sur une autre copie de ton fichier avec ces quatre modifications et l'on aura pour dessert une Pomme.

Option Explicit
Dim Dic_Produits_MMR_Dessert As Object, Dic_Produits_MMR_Légumes As Object, Dic_Produits_MMR_Viandes As Object, Dic_Produits_MJ_Desserts As Object
Dim Dic_Produits_MJ_Légumes As Object, Dic_Produits_MJ_Viandes As Object, Dic_Produits_MVMW_Viandes As Object
Dim DateCréationArticlesMenus As Date

Dim ConserverFormatDate As Date  ' modif_Bastr 1

Private Sub cbNomNatureArticlesMenus_Change()
Dim I As Integer
    If cbNomNatureArticlesMenus.ListIndex = -1 Then Exit Sub
    I = cbNomNatureArticlesMenus.ListIndex + 1
'Va permettre de remplir le contenu du tbCodeNatureArticlesMenus.
    tbCodeNatureArticlesMenus = [TabNatureArticleMenu].ListObject.ListColumns("Code nature article menu").DataBodyRange(I)
    Call ModificationLibellés
End Sub

Private Sub cbNomNatureCréation_Change()
Dim Lig As Byte
'Effacer le contenu des cb et des tb si cbNomNatureCréation est vide.
    If cbNomNatureCréation = "" Then
        tbCodeNatureCréation.Value = ""
        cbNomNatureArticlesMenus.Value = ""
        tbCodeNatureArticlesMenus.Value = ""
    End If
    If cbNomNatureCréation.ListIndex = -1 Then Exit Sub

    Lig = cbNomNatureCréation.ListIndex + 1
    tbCodeNatureCréation = [TabNatureCréation].ListObject.ListColumns("Code nature création").DataBodyRange(Lig)
    Call ModificationLibellés
'Si le tbDateCréationArticlesMenus est vide, alors appel de la procédure tbDateCréationArticlesMenus_Change.
    If tbDateCréationArticlesMenus.Value <> "" Then Call tbDateCréationArticlesMenus_Change
End Sub

Private Sub cmdRetourFeuilleAccuei_Click()
'Ferme le formulaire et retourne sur la feuille Accueil.
    Unload Me
End Sub
'====

Private Sub tbDateCréationArticlesMenus_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Va afficher le calendrier dans lequel on choisira l'année, le mois et la date qui, grâce à dddd d, sera transformée en jour de la semaine, date, mois et année.
    DateCréationArticlesMenus = Calendrier.Choix(Me.tbDateCréationArticlesMenus)

       ConserverFormatDate = DateCréationArticlesMenus  '' modif_Bastr 2

        If DateCréationArticlesMenus > 0 Then Me.tbDateCréationArticlesMenus.Value = Format(DateCréationArticlesMenus, "dddd d mmmm yyyy")
End Sub

Private Sub UserForm_Activate()
'Initialisation cbNomNatureCréation : va afficher, dans le combobox cbNomNatureCréation, la liste des noms prise dans la feuille Listes, tableau structuré TabNatureCréation, co-
'lonne Nom nature création.
'DataBodyRange : cette propriété renvoie un objet Range qui représente la plage de valeurs, à l'exception de la ligne d'en-tête, dans une table. Type de données en lecture seule.
    cbNomNatureCréation.List = [TabNatureCréation].ListObject.ListColumns(1).DataBodyRange.Value
'Initialisation cbNomNatureArticlesMenus : va afficher, dans le combo box cbNomNatureArticlesMenus, la liste des noms prise dans la feuille Listes, tableau structuré TabNature
'ArticleMenu, colonne Nom nature article menu.
'DataBodyRange : cette propriété renvoie un objet Range qui représente la plage de valeurs, à l'exception de la ligne d'en-tête, dans une table. Type de données en lecture seule.
    cbNomNatureArticlesMenus.List = [TabNatureArticleMenu].ListObject.ListColumns(1).DataBodyRange.Value
End Sub

Private Sub ModificationLibellés()
Dim Suffixe As String
'Modification des libellés : va modifier la caption des intitulés en prenant la caption de l'intitulé en y ajoutant le Suffixe.
    Suffixe = " " & LCase(cbNomNatureCréation.Value)
    lbNomNatureCréation.Caption = "Nom nature" & Suffixe
    Suffixe = " " & LCase(cbNomNatureCréation.Value) & " " & LCase(cbNomNatureArticlesMenus.Value)
    lbNomNatureArticlesMenus.Caption = "Nom nature" & Suffixe
End Sub

Private Sub tbDateCréationArticlesMenus_Change()
    Dim JourSemaine As Integer, Clé As String, Ctrl As Control, Date_Création_Articles_Menus As String, J As Integer
    Application.ScreenUpdating = False
    'Effacement préalable des listes nom.
    For Each Ctrl In Me.FrameSaisiesPrédéfiniesCréationArticlesMenus.Controls
        If TypeOf Ctrl Is MSForms.ComboBox Then Ctrl.Clear
    Next Ctrl
    'Si vérification Date création articles menus Nok, on ne fait rien, on sort de la procédure.
    If VérifDateCréationArticlesMenus = False Then Exit Sub
    'Génération des dictionnaires MMR, MJ, MVMW pour les Desserts, légumes et viandes.
    Set Dic_Produits_MMR_Dessert = CreateObject("Scripting.Dictionary")
    Set Dic_Produits_MMR_Légumes = CreateObject("Scripting.Dictionary")
    Set Dic_Produits_MMR_Viandes = CreateObject("Scripting.Dictionary")
    Set Dic_Produits_MJ_Desserts = CreateObject("Scripting.Dictionary")
    Set Dic_Produits_MJ_Légumes = CreateObject("Scripting.Dictionary")
    Set Dic_Produits_MJ_Viandes = CreateObject("Scripting.Dictionary")
    Set Dic_Produits_MVMW_Viandes = CreateObject("Scripting.Dictionary")

    JourSemaine = Weekday(ConserverFormatDate, vbMonday) ' modif_Bastr 3

    With [TabProduits].ListObject
        For J = 1 To .ListRows.Count
            Clé = .ListColumns("Nom produit").DataBodyRange(J)
            If .ListColumns("Code produit").DataBodyRange(J) Like "DMR*" Then Dic_Produits_MMR_Dessert(Clé) = "DMR"
            If .ListColumns("Code produit").DataBodyRange(J) Like "LMR*" Then Dic_Produits_MMR_Légumes(Clé) = "LMR"
            If .ListColumns("Code produit").DataBodyRange(J) Like "VMR*" Then Dic_Produits_MMR_Viandes(Clé) = "VMR"
            'Select Case exécute l'un des blocs d'instructions indiqués. Selon la valeur d'une expression, va exécuter l'instruction indiquée sur la ligne Case.
            Select Case JourSemaine
                Case 1, 2
                    'DataBodyRange : cette propriété renvoie un objet Range qui représente la plage de valeurs, à l'exception de la ligne d'en-tête, dans une table. Type de données en lecture seule.
                    If .ListColumns("Code produit").DataBodyRange(J) Like "DS*" Then Dic_Produits_MJ_Desserts(Clé) = "DS"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "LSLM*" Then Dic_Produits_MJ_Légumes(Clé) = "LSL"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "VS*" Then Dic_Produits_MJ_Viandes(Clé) = "VS"
                Case 3
                    If .ListColumns("Code produit").DataBodyRange(J) Like "DS*" Then Dic_Produits_MJ_Desserts(Clé) = "DS"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "LSMJ*" Then Dic_Produits_MJ_Légumes(Clé) = "LSM"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "VS*" Then Dic_Produits_MJ_Viandes(Clé) = "VS"
                Case 5
                    If .ListColumns("Code produit").DataBodyRange(J) Like "DS*" Then Dic_Produits_MJ_Desserts(Clé) = "DS"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "LSV*" Then Dic_Produits_MJ_Légumes(Clé) = "LSV"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "VS*" Then Dic_Produits_MJ_Viandes(Clé) = "VS"
                Case 6
                    If .ListColumns("Code produit").DataBodyRange(J) Like "DW*" Then Dic_Produits_MJ_Desserts(Clé) = "DW"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "LWS*" Then Dic_Produits_MJ_Légumes(Clé) = "LWS"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "VS*" Then Dic_Produits_MJ_Viandes(Clé) = "VS"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "VMW*" Then Dic_Produits_MVMW_Viandes(Clé) = "VMW"
                Case 7
                    If .ListColumns("Code produit").DataBodyRange(J) Like "DW*" Then Dic_Produits_MJ_Desserts(Clé) = "DW"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "LWD*" Then Dic_Produits_MJ_Légumes(Clé) = "LWD"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "VS*" Then Dic_Produits_MJ_Viandes(Clé) = "VS"
                    If .ListColumns("Code produit").DataBodyRange(J) Like "VMW*" Then Dic_Produits_MVMW_Viandes(Clé) = "VMW"
            End Select
        Next J
    End With
    'Affichage de la liste des desserts, légumes et viandes pour menu midi retraite; menu journalier et menu viandes midi weekend.

    Select Case tbCodeNatureCréation.Value ' modif_Bastr 3

        'Select Case exécute l'un des blocs d'instructions indiqués. Selon la valeur d'une expression, va exécuter l'instruction indiquée sur la ligne Case.
        Case Is = "MMR"
            If JourSemaine <= 5 Then
                cbNomDessert.List = Dic_Produits_MMR_Dessert.keys
            End If
    End Select
End Sub

Private Function VérifDateCréationArticlesMenus() As Boolean

    VérifDateCréationArticlesMenus = IsDate(ConserverFormatDate)  ' modif_Bastr 4

End Function

Bast

Bonjour Bastr (ou Jésus Christ),

J'ai modifié mon code selon tes indications. Premier essaie : pas de résultat souhaité (clic sur création articles menus dans le formulaire UF01)). Deuxième essai (clic sur Menu midi retraite dans le formulaire UF01) : résultat satisfaisant (il faut toutefois toujours une date création articles menus). Merci pour ton aide. Maintenant, je vais essayer d'obtenir la liste des légumes de midi retraite.

Bonjour Bastr,

Serait-il possible de créer un programme pour la création des articles menus (rien à voir avec la création des menus) qui utiliserait dictionary mais sans avoir recours à aucune date, sans avoir recours à weekday, sans avoir recours à JourSemaine : sur la feuille accueil, un clic sur création articles menus, dans le formulaire, un clic sur DMR, puis on remplit toutes les cb nécessaires et on valide pour l'enregistrer la TabBDArticles ?

D'avance merci pour ta réponse.

Bonsoir à toutes et à tous,

Grâce à un précédent programme et à Bastr, mes cbnom se remplissent. Mais je souhaiterais que si le cbnomnaturearticlemenu est LSLM alors le cbNomLégume ne devra afficher que la liste des légumes LSLM (même chose pour les desserts soirs, desserts weekend et les viandes). Peut-être faut-il suivre l'idée de Bastr et de faire des case 1, 2;case 3,4, etc. ? Ou bien prévoir des Dic_Produits_MJ_Desserts_Soirs, Desserts weekend, et ainsi de suite pour les légumes et les viandes. Je vais essayer.

D'avance merci pour votre aide.