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

On ne se sert pas du tableau TabBDArticlesMenus ?

Ben Si. Voir procédure :

Private Sub infos_période_conditionnement

Mille excuses : je n'avais pas tout lu jusqu'au bout. Avec ces nouvelles instructions, le problème de non affichage de la liste légumes et viandes midi retraite va-t-il disparaître ?

J'ai dû faire une erreur dans la recopie manuelle des instructions car si je fais un copier-coller, tout se passe bien.

J'ai comparé tes instructions d'hier avec les miennes que j'ai tapées manuellement et je ne vois aucune différence. Je ne comprends pas pourquoi cela ne fonctionne pas.

J'ai comparé tes instructions d'hier avec les miennes que j'ai tapées manuellement et je ne vois aucune différence. Je ne comprends pas pourquoi cela ne fonctionne pas.

envoie-moi la dernière version du fichier.

Mon fichier avec tes instructions que j'ai tapées manuellement.

Cette version est antérieure à la solution que j'ai proposée ici

https://forum.excel-pratique.com/excel/cet-article-existe-deja-ne-s-execute-pas-180079/4#p1122142

Bonjour thev,

Oui, elle est antérieure mais je voudrais savoir si j'ai fait une erreur en la retapant et, si oui, où est cette erreur. Je vais m'occuper de la nouvelle cette après-midi.

Bonjour thev,

C'est parfait. Par contre, le tbjourférié ne se remplit pas quand on choisit une date correspondant à un jour férié.

Par contre, le tbjourférié ne se remplit pas quand on choisit une date correspondant à un jour férié.

ci-jointe correction

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

    '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

    'Vérification jour férié.
     j = 0
    '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 = Application.Match(CStr(CDate(date_menu)), Range("TabJoursFériés[Date jours fériés]").Value, 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

    '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 ?
    JourSemaine = Weekday(CDate(date_menu), vbMonday)
    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

tests-ccm-thev.xlsm (205.34 Ko)

Il manque le reste du code

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

Bonjour thev,

C'est quoi "Il manque le reste du code" ? J'ai rectifié mais tbjourférié reste toujours vide.

Dans le fichier TESTS CCM.xlsm : datemenu_mousedown : je mets dddd d mmmm yyyy : à l'exécution, j'ai un message d'erreur d'incompatibilité de type dans la procédure function verifdatemenu, ligne If Weekday(tbDateMenu.Value, vbMonday) >= 6 Then.

Si je fais le programme tel que celui que tu m'as envoyé ce matin, le tbjourférié ne se remplit pas.

Dans ce fichier, une saisie menu midi retraite, avec une date menu correspondant à un jour férié, tout fonctionne. Si date menu est un jour hors jour férié, il y a une erreur.

Si date menu est un jour hors jour férié, il y a une erreur.

Oui, il faut insérer ces 2 instructions

    On Error Resume Next
    j = Application.Match(CStr(CDate(date_menu)), Range("TabJoursFériés[Date jours fériés]").Value, 0)
    On Error GoTo 0

et d'ailleurs ici également

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
        On Error Resume Next
        i = Application.Match(clé, .ListColumns("clé article").DataBodyRange, 0)
        On Error GoTo 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

Dans le fichier TESTS CCM.xlsm : datemenu_mousedown : je mets dddd d mmmm yyyy : à l'exécution, j'ai un message d'erreur d'incompatibilité de type dans la procédure function verifdatemenu, ligne If Weekday(tbDateMenu.Value, vbMonday) >= 6 Then.

ci_dessous correction

Private Function VérifDateMenu() As Boolean
    Dim date_menu As String, tb() As String, i As Integer

    VérifDateMenu = True

    '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

    '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 cbNomNatureCréation.Value
        Case Is = "Menu midi retraite"
            'Menu midi retraite : vérification saisie date du lundi au vendredi. Si weekday supérieur ou égal à 6 alors apparition du message demandant de saisir une date du lundi au vendre-
            'di inclus.
            If Weekday(CDate(date_menu), vbMonday) >= 6 Then
                MsgBox "Menu midi retraite : saisir une date du lundi au vendredi inclus !", vbExclamation
                VérifDateMenu = False
            End If

        Case Is = "Menu viande midi weekend"
        'Menu viande midi weekend : vérification saisie date du samedi au dimanche. Si Weekday inférieur ou égal à 6 alors apparition du message demandant de saisir une date du sa-
        'medi au dimanche inclus.
            If Weekday(CDate(date_menu), vbMonday) < 6 Then
                MsgBox "Menu viande midi weekend : saisir une date du samedi au dimanche inclus !", vbExclamation
                VérifDateMenu = False
            End If
    End Select

End Function

fichier TESTS CCM.xlm : rectification du code; Une nouvelle erreur.

fichier TESTS CCM.xlm : rectification du code; Une nouvelle erreur.

Une version antérieure qui ne correspond pas aux dernières modifications communiquées. SVP travaillez avec les dernières versions

https://forum.excel-pratique.com/excel/cet-article-existe-deja-ne-s-execute-pas-180079/5#p1122522

et leurs corrections car il devient alors impossible de vous suivre.

Bonjour thev,

Les instructions données hier soir entre 19 heures et 19 heures 15 doivent être dans un même fichier ?

Merci. Je vais rectifier ce fichier en conséquence et je te tiendrai au courant du résultat vers 11 heures.