Cet article existe déjà : ne s'exécute pas

Bonjour Thev,

C'est presque parfait. Il y a quelques modifications à apporter que je vais pouvoir faire seul. Je te tiendrai au courant mais que dans la soirée car j'ai pas de choses à faire cette après-midi ne concernant pas mon programme. Une question : avec les nouveaux formulaires, pourrais-je effectuer des modifications. Si non, y a-t-il une solution pour pouvoir les effectuer tout en conservant totalement ou partiellement l'actuelle présentation ?

Bon appétit. Bonne après-midi. Prends bien soin de toi.

Bonsoir thev,

Pourquoi la cellule J23 me met faux ?

Premier mot de passe : SOLDES 2023

Deuxième mot de passe : SOLDES 202

D'avance merci pour ton aide.

Pourquoi la cellule J23 me met faux ?

Un problème d'arrondi

=SI(ARRONDI(I23;2)<>ARRONDI(I22;2);"Faux";"Bon")

Bonjour l'encyclopédie universelle thev,

Je vais tester. Merci. Que ferais-je sans toi ? Cela marche. J'ai fait un copier-coller de la formule partout où cela était nécessaire. Maintenant je vais retravailler sur mon fichier TESTS CCM.xlsm.

Mes différents cadres me conviennent. Clic sur Création menu : c'est ok ainsi que le retour feuille accueil création. Clic sur Menu midi retraite, le deuxème cadre disparaît, c'est parfait. Clic sur retour feuille accueil création : rien ne se passe. Merci de m'apporter tes lumières étincelantes, resplendissantes.

Bonjour,

Clic sur retour feuille accueil création : rien ne se passe.

Il vous manque la procédure événementielle associée :

Private Sub cmdRetourFeuille_Click()
    'Ferme le formulaire et retour à la feuille Accueil articles budgets.
    Unload Me
End Sub

bonjour thev,

Je viens de m'apercevoir le pourquoi. Initialement, j'avais mis Retour feuille accueil création et je n'avais pas remarqué qu'une erreur survenait (nom ambigu) et que de ce fait, le (Name) avait été tronqué.

Bonsoir thev,

Dans le fichier MENUS 2023.xlsm (premier mot de passe : MENUS 2023, deuxième mot de passe : MENUS 2023), procédure private sub tbDateMenu_Change, partie Initialisations des listes codes : case MMR : cbCML.List=range("LLMR").Value

Dans le fichier TESTS CCM.xlsm, procédure private sub tbDateMenu_Change, partie initialisations des listes codes : case MMR (pour l'instant, il n'y a rien) : quelle sera l'instruction à écrire afin d'avoir la liste soit par code, soit par nom, sachant que ces informations sont dans le tableau à quatre colonnes TabProduits de la feuille listes ? Mon souhait serait que j'ai la liste des légumes concernant uniquement menu midi retraite. Je pense à quelque chose comme ce qui suit :

With [TabProduits].ListObject
'Renvoie l'indice de l'article du tableau structuré TabProduits pour la clé article définie si l'article existe. Renvoie zéro si l'article
'n'existe pas.
I = 0
I = Application.Match(cbNomArticleMenu & cbNomNatureArticleMenu, .ListColumns("Clé produit").DataBodyRange.Value, 0)
If I > 0 Then tbCodeArticleMenu = .ListColumns("Code produit").DataBodyRange(I)
End With

ou bien aller chercher les renseignements dans la feuille BDArticlesMenus, tableau BDArticlesMenus selon des critères (lesquels ?).

La function VérifDateMenu n'est pas encore écrite. C'est peut-être la raison pour laquelle tbjoursfériés ne se remplit pas (j'ai testé avec le 15 août 2023).

D'avance merci pour tes précieux conseils.

Edit modo : fichier Menu déjà posté dans ce fil ici --> https://forum.excel-pratique.com/s/goto/1117104

Bonjour thev,

J'ai écrit le code de private function VérifDateMenu. À l'exécution, tant pour menu midi retraite que pour menu viande midi weekend, j'ai une incompatibilité de type sur les deux instructions suivantes :

Pour case menu midi retraite

If Weekday(tbDateMenu.Value, vbMonday) >= 6 Then

pour case menu viande midi weekend

If Weekday(tbDateMenu.Value, vbMonday) < 6 Then

J'ai pris l'exemple de ces deux instructions dans le fichier Menus 2023 que je vous ai envoyé hier. Comme les cb sont devenus des tb et les tb ont été transformés en cb, c'est peut-être boolean qui n'est plus valable. J'ai trouvé la solution : dans private sub DateMenu_MouseDown, il faut garder d et supprimer les dddd. Je n'ai plus d'erreur et j'ai bien le message qui s'affiche. Par contre, le jour de la semaine (lundi, mardi, etc.) ne s'affiche plus. Si tu as une solution qui permettrait d'afficher, par exemple, lundi 06 février 2023, et en modifiant un boolean en je ne sais pas quoi pour qu'il n'y plus de message d'incompatibilité de type, elle serait la bienvenue.

Bonjour thev,

Problème jour férié résolu : le tb se remplit bien.

Bonjour,

Le plus simple est de passer par la création de 2 dictionnaires. Ci-dessous code :

Private Sub tbDateMenu_Change()
    Dim ctrl As Control
    Dim dic_produits_MMR_légumes As Object, dic_produits_MMR_viandes As Object
    Dim tb() As String
    Dim date_menu As String, clé As String
    Dim JourSemaine As Integer
    Dim i As Integer, j As Integer

    'Effacement préalable des listes nom.
    For Each ctrl In Me.Frm_SaisiesPrédéfiniesCréationMenus.Controls
        If TypeOf ctrl Is MSForms.ComboBox Then ctrl.Clear
    Next ctrl

    'Si vérification date menu Nok on ne fait rien, on sort de la procédure.
    'If VérifDateMenu = False Then Exit Sub

    'Vérification jour férié.
     'On Error Resume Next : Lorsqu'une erreur d'exécution survient, le contrôle est transmis à l'instruction qui suit immédiatement celle où l'erreur s'est produite, et l'exécution conti-
     'nue. Il est recommandé d'utiliser cette formulation plutôt que l'instruction On Error GoTo pour accéder à des objets.
     On Error Resume Next
    'WorksheetFunction.Match : Renvoie la position relative d'un élément dans une matrice (matrice : permet de créer des formules uniques permettant d’obtenir plusieurs résultats
    'et qui agissent sur un groupe d’arguments répartis dans des lignes et des colonnes. Une plage matricielle partage une même formule tandis qu’une constante matricielle est
    'un groupe de constantes qui sert d’argument.), qui correspond à une valeur spécifiée dans un ordre spécifié. Utilisez la fonction MATCH au lieu de l'une des fonctions
    'LOOKUP lorsque vous avez besoin de la position d'un élément dans une plage au lieu de l'élément proprement dit.
    j = WorksheetFunction.match(CLng(DateValue(tbDateMenu.Value)), Range("TabJoursFériés[Date jours fériés]"), 0)
    'On Error Goto 0 : Valide la routine de gestion d'erreur commençant à la ligne indiquée dans l'argument line. L'argument line peut être une étiquette de ligne ou un numéro de li-
    'gne. En cas d'erreur d'exécution, le contrôle est transmis au point indiqué dans l'argument line, ce qui valide le gestionnaire d'erreurs. La ligne indiquée dans l'argument line doit
    'se trouver dans la même procédure que l'instruction On Error ; sinon, une erreur se produit au moment de la compilation.
    On Error GoTo 0

    If j > 0 Then
        tbJoursFériés.Value = Range("TabJoursFériés[Nom jours fériés]").Item(j)
    Else
        tbJoursFériés.Value = ""
    End If

    '// Initialisations des listes codes articles selon code nature menu et date menu..

    'génération dictionnaires dic_produits_MMR_légumes et dic_produits_MMR_viande
    Set dic_produits_MMR_légumes = CreateObject("Scripting.Dictionary")
    Set dic_produits_MMR_viandes = CreateObject("Scripting.Dictionary")
    With [TabProduits].ListObject
        For j = 1 To .ListRows.Count
            clé = .ListColumns("Code produit").DataBodyRange(j)
            If clé Like "LMR*" Then dic_produits_MMR_légumes(clé) = .ListColumns("Nom produit").DataBodyRange(j)
            If clé Like "VMR*" Then dic_produits_MMR_viandes(clé) = .ListColumns("Nom produit").DataBodyRange(j)
        Next j
    End With

    'récupération de la date sélectionnée via suppression du jour dans la date formatée
    tb = Split(tbDateMenu.Value, " ")
    date_menu = Empty
    For i = 1 To UBound(tb)
        date_menu = date_menu & tb(i) & " "
    Next i
    JourSemaine = Weekday(CDate(date_menu), vbMonday)

    'Si tbCodenatureCréation égale MMR et si date menu correspond à un samedi ou à un dimanche, les cbCML, cbCMV et cbCMD restent vides.Pourquoi ?
    'Si tbCodenatureCréation égale MVMW et si date menu ucorrespond à un jour autre que samedi ou dimanche, le cbCMV reste vide. Pourquoi ?
    Select Case tbCodenatureCréation.Value
        Case "MMR"
            'Du lundi au vendredi inclus.
            If JourSemaine <= 5 Then 'Si jour semaine inférieur ou égal à 5 alors.
                cbNomLégume.List = dic_produits_MMR_légumes.items 'Va afficher la liste des codes articles légumes midi retraite.
                cbNomViande.List = dic_produits_MMR_viandes.items 'Va afficher la liste des codes articles viandes midi retraite.
            End If
    End Select

End Sub

Bonjour thev,

et ce sera le même principe pour les légumes journalier (lundi et mardi, mercredi et jeudi, etc. ?), viandes, desserts weekend ? Faut-il modifier le formulaire avec la création d'un dictionnaire ? Par rapport au fichier MENUS 2023, des procédures sont-elles devenues inutiles et sont donc à supprimer ? Si oui, lesquelles ? Par devenues inutiles et à supprimer, je veux dire qu'elles ne doivent plus figurer dans le fichier TESTS CCM

Bonjour thev,

Tu emploies MMR qui existait dans le fichier MENUS 2023; dans le fichier TESTS CCM, MMR n'existe pas. Ne faudrait-il pas le remplacer par le nom actuel figurant dans le fichier TESTS CCM (colonne libellé produit du tabProduits de la feuille Listes, et, si oui, que devrait être l'instruction. Mêmes observations et question pour LMR et VMR. D'avance merci pour ta réponse.

et ce sera le même principe pour les légumes journalier (lundi et mardi, mercredi et jeudi, etc. ?), viandes, desserts weekend ?

Oui, un dictionnaire par liste. Tous créés via un seul balayage de la table TaBProduits

Faut-il modifier le formulaire avec la création d'un dictionnaire ?

Non, car ces dictionnaires sont créés uniquement en mémoire (donc dynamiques) et disparaissent après exécution du code.

dans le fichier TESTS CCM, MMR n'existe pas.

MMR est bien pourtant présent dans la table TabNatureCréation

Bonsoir thev,

Je n'avais pas compris (ni vu) qu'il s'agissait de cette table, je croyais qu'on ne parlait que de la table Produits (with [TabProduits])

Bonjour thev,

Au lieu de prendre le tableau TabProduits, serait-il possible de rechercher les informations à partir du tableau TabBDArticlesMenus afin d'avoir d'un seul coup, pour un article donné, tous les renseignements y afférents : code article, nom et code période, nom et code conditionnement ? D'avance merci pour ta réponse et l'éventuel code.

Bonjour thev,

Le fichier modifié avec les indications mentionnées dans ton message d'hier de 14 heures 50 (sauf erreur ou omission de ma part) mais je n'ai pas la liste des légumes et viande menu midi retraite. le problème est le même si je mets case Menu midi retraite. J'ai rajouté le mot clé là où il manquait mais cela ne résout pas le problème.

Au lieu de prendre le tableau TabProduits, serait-il possible de rechercher les informations à partir du tableau TabBDArticlesMenus afin d'avoir d'un seul coup, pour un article donné, tous les renseignements y afférents : code article, nom et code période, nom et code conditionnement ?

ci-dessous une solution :

Option Explicit

Dim dic_produits_MMR_légumes As Object, dic_produits_MMR_viandes As Object, dic_produits_MMR_desserts As Object

Private Sub tbDateMenu_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.
    tbDateMenu = Format(Calendrier.Choix(tbDateMenu), "dddd d mmmm yyyy")
End Sub
'tests-ccm2(1).xlsm Mardi 17 janvier 2023 à 12h35.
Private Sub UserForm_Initialize()
    Dim liste()

'.............
'.............

Private Sub tbDateMenu_Change()
    Dim ctrl As Control
    Dim tb() As String
    Dim date_menu As String, clé As String
    Dim JourSemaine As Integer
    Dim i As Integer, j As Integer

    'Effacement préalable des listes nom.
    For Each ctrl In Me.Frm_SaisiesPrédéfiniesCréationMenus.Controls
        If TypeOf ctrl Is MSForms.ComboBox Then ctrl.Clear
    Next ctrl

    'Si vérification date menu Nok on ne fait rien, on sort de la procédure.
    'If VérifDateMenu = False Then Exit Sub

    'Vérification jour férié.
     'On Error Resume Next : Lorsqu'une erreur d'exécution survient, le contrôle est transmis à l'instruction qui suit immédiatement celle où l'erreur s'est produite, et l'exécution conti-
     'nue. Il est recommandé d'utiliser cette formulation plutôt que l'instruction On Error GoTo pour accéder à des objets.
     On Error Resume Next
    'WorksheetFunction.Match : Renvoie la position relative d'un élément dans une matrice (matrice : permet de créer des formules uniques permettant d’obtenir plusieurs résultats
    'et qui agissent sur un groupe d’arguments répartis dans des lignes et des colonnes. Une plage matricielle partage une même formule tandis qu’une constante matricielle est
    'un groupe de constantes qui sert d’argument.), qui correspond à une valeur spécifiée dans un ordre spécifié. Utilisez la fonction MATCH au lieu de l'une des fonctions
    'LOOKUP lorsque vous avez besoin de la position d'un élément dans une plage au lieu de l'élément proprement dit.
    j = WorksheetFunction.match(CLng(DateValue(tbDateMenu.Value)), Range("TabJoursFériés[Date jours fériés]"), 0)
    'On Error Goto 0 : Valide la routine de gestion d'erreur commençant à la ligne indiquée dans l'argument line. L'argument line peut être une étiquette de ligne ou un numéro de li-
    'gne. En cas d'erreur d'exécution, le contrôle est transmis au point indiqué dans l'argument line, ce qui valide le gestionnaire d'erreurs. La ligne indiquée dans l'argument line doit
    'se trouver dans la même procédure que l'instruction On Error ; sinon, une erreur se produit au moment de la compilation.
    On Error GoTo 0

    If j > 0 Then
        tbJoursFériés.Value = Range("TabJoursFériés[Nom jours fériés]").Item(j)
    Else
        tbJoursFériés.Value = ""
    End If

    '// Initialisations des listes codes articles selon code nature menu et date menu..

    'génération dictionnaires dic_produits_MMR_légumes, dic_produits_MMR_viandes et dic_produits_MMR_desserts
    Set dic_produits_MMR_légumes = CreateObject("Scripting.Dictionary")
    Set dic_produits_MMR_viandes = CreateObject("Scripting.Dictionary")
    Set dic_produits_MMR_desserts = CreateObject("Scripting.Dictionary")
    With [TabProduits].ListObject
        For j = 1 To .ListRows.Count
            clé = .ListColumns("Nom produit").DataBodyRange(j)
            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"
            If .ListColumns("Code produit").DataBodyRange(j) Like "DMR*" Then dic_produits_MMR_desserts(clé) = "DMR"
        Next j
    End With

    'récupération de la date sélectionnée via suppression du jour dans la date formattée
    tb = Split(tbDateMenu.Value, " ")
    date_menu = Empty
    For i = 1 To UBound(tb)
        date_menu = date_menu & tb(i) & " "
    Next i
    JourSemaine = Weekday(CDate(date_menu), vbMonday)

    'Si tbCodenatureCréation égale MMR et si date menu correspond à un samedi ou à un dimanche, les cbCML, cbCMV et cbCMD restent vides.Pourquoi ?
    'Si tbCodenatureCréation égale MVMW et si date menu ucorrespond à un jour autre que samedi ou dimanche, le cbCMV reste vide. Pourquoi ?
    Select Case tbCodenatureCréation.Value
        Case "MMR"
            'Du lundi au vendredi inclus.
            If JourSemaine <= 5 Then 'Si jour semaine inférieur ou égal à 5 alors.
                cbNomLégume.List = dic_produits_MMR_légumes.keys 'Va afficher la liste des noms légumes midi retraite.
                cbNomViande.List = dic_produits_MMR_viandes.keys 'Va afficher la liste des noms viandes midi retraite.
                cbNomDessert.List = dic_produits_MMR_desserts.keys 'Va afficher la liste des noms desserts midi retraite.
            End If
    End Select

End Sub

Private Sub cbNomLégume_Change()
    Dim nom_période As String, code_période As String, nom_cond As String, code_cond As String

    If Me.cbNomLégume = Empty Then Exit Sub

    Me.tbCodeLégume = dic_produits_MMR_légumes(cbNomLégume.Value)
    Call infos_période_conditionnement(Me.tbCodeLégume & Me.cbNomLégume, nom_période, code_période, nom_cond, code_cond)
    Me.cbNomPériodeLégume = nom_période: Me.tbCodePériodeLégume = code_période: Me.cbNomConditionnementLégume = nom_cond: Me.tbCodeConditionnementLégume = code_cond

End Sub

Private Sub cbNomViande_Change()
    Dim nom_période As String, code_période As String, nom_cond As String, code_cond As String

    If Me.cbNomViande = Empty Then Exit Sub

    Me.tbCodeViande = dic_produits_MMR_viandes(cbNomViande.Value)
    Call infos_période_conditionnement(Me.tbCodeViande & Me.cbNomViande, nom_période, code_période, nom_cond, code_cond)
    Me.cbNomPériodeViande = nom_période: Me.tbCodePériodeViande = code_période: Me.cbNomConditionnementViande = nom_cond: Me.tbCodeConditionnementViande = code_cond

End Sub

Private Sub cbNomDessert_Change()
    Dim nom_période As String, code_période As String, nom_cond As String, code_cond As String

    If Me.cbNomDessert = Empty Then Exit Sub

    Me.tbCodeDessert = dic_produits_MMR_desserts(cbNomDessert.Value)
    Call infos_période_conditionnement(Me.tbCodeDessert & Me.cbNomDessert, nom_période, code_période, nom_cond, code_cond)
    Me.cbNomPériodeDessert = nom_période: Me.tbCodePériodeDessert = code_période: Me.cbNomConditionnementDessert = nom_cond: Me.tbCodeConditionnementDessert = code_cond

End Sub

Private Sub infos_période_conditionnement(clé As String, nom_période As String, code_période As String, nom_cond As String, code_cond As String)
    Dim i As Long

    With [TabBDArticlesMenus].ListObject
        i = 0: nom_période = Empty: code_période = Empty: nom_cond = Empty: code_cond = Empty
        i = Application.match(clé, .ListColumns("clé article").DataBodyRange.Value, 0)
        If i > 0 Then
            nom_période = .ListColumns("Nom période article menu").DataBodyRange(i)
            code_période = .ListColumns("Code période article menu").DataBodyRange(i)
            nom_cond = .ListColumns("Nom conditionnement article menu").DataBodyRange(i)
            code_cond = .ListColumns("Code conditionnement article menu").DataBodyRange(i)
        End If
    End With

End Sub

Merci. Tout ce qui précède Private sub TbDatemenu_Change, je le mets dans UserForm_Activate (ou Initialize) ?

Bonsoir thev,

On ne se sert pas du tableau TabBDArticlesMenus ?

Tout ce qui précède Private sub TbDatemenu_Change, je le mets dans UserForm_Activate (ou Initialize) ?

Il faut juste mettre la définition des variables_objets des dictionnaires au niveau du module, c'est à dire avant toute procédure Sub et donc juste après "Option Explicit". Ce qui permet à ces variables d'être utilisées par n'importe quelle procédure du module associé au UserForm "UF01_Création"

Option Explicit

Dim dic_produits_MMR_légumes As Object, dic_produits_MMR_viandes As Object, dic_produits_MMR_desserts As Object

Private Sub tbDateMenu_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As