Variable objet ou variable de bloc with non définie

Bonjour à toutes et à tous,

Feuille Accueil création : clic sur Création;

Nom nature : dans la liste déroulante cliquer sur Menu journalier;

Date menu : choisir 12 février : j'ai un message d'erreur concernant la procédure tbDateMenu_Change, case "MJ" : viande toute la semaine, dessert cas le plus fréquent; la même erreur (si je met cette instruction en commentaire ) se produit pour Select case JourSemaine, dimanche, case 7, pour légumes (il y a de fortes chances que cela soit pareil pour desserts) : variable objet ou variable de bloc with non définie.

D'avance merci à celle ou à celui qui va m'apporter son aide pour corriger cette erreur.

RécupérerInfosMenu n'est pas encore codifié.

RécupérationMenu est codifié. À voir si des erreurs sont susceptibles d'apparaître.

31tests-ccm-thev.xlsm (212.61 Ko)

Bonjour

Les dicos dic_produits_MJ_légumes , dic_produits_MJ_viandes , dic_produits_MJ_desserts sont vides

N'y aurai t'il pas une erreur: cbNomViande.List = dic_produits_MJ_légumes.keys

A+ François

Bonjour Fanfan38,

Comment faire pour les remplir. Dans quelle procédure cela doit-il être fait ? Peut-être dans les cbNomLégume_Change, cbNomViande_Change et cbNomDessert_Change, avec, éventuellement, des select case MMR, MJ, MVMW ? De la même manière que pour MMR ?

Dans UF01_Creation

la macro: Private Sub tbDateMenu_Change() à la ligne 313 tu dois saisir ces lignes et les compléter

            If .ListColumns("Code produit").DataBodyRange(j) Like "DMR*" Then dic_produits_MMR_desserts(clé) = "DMR"

Ce sont celles ci qu'il faut ajouter et completer sous la ligne ci-dessus...
 '           If .ListColumns("Code produit").DataBodyRange(j) Like "*" Then dic_produits_MJ_légumes(clé) = ""
 '           If .ListColumns("Code produit").DataBodyRange(j) Like "*" Then dic_produits_MJ_viandes(clé) = ""
'            If .ListColumns("Code produit").DataBodyRange(j) Like "*" Then dic_produits_MJ_desserts(clé) = ""

A+ François

Merci. Encore une précision : pour MJ, les légumes, un like pour LSLM, LSMJ, etc. et après clé pareil ? Même principe pour les desserts ?

À partir de la ligne 328, faut-il continuer la codification ou est-elle devenue inutile ?

Bonjour

Ci joint la macro modifié (à controler)

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
'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.
'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
    j = Application.Match(CStr(CDate(date_menu)), Range("TabJoursFériés[Date jours fériés]").Value, 0)
'On Error GoTo 0 :Invalide dans la procédure en cours tout gestionnaire d 'erreurs validé
        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")
    Set dic_produits_MJ_légumes = CreateObject("Scripting.Dictionary")
    Set dic_produits_MJ_viandes = CreateObject("Scripting.Dictionary")
    Set dic_produits_MJ_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"
            If .ListColumns("Code produit").DataBodyRange(j) Like "LSM*" Then dic_produits_MJ_légumes(clé) = "LSM"
            If .ListColumns("Code produit").DataBodyRange(j) Like "LSV*" Then dic_produits_MJ_viandes(clé) = "LSV"
            If .ListColumns("Code produit").DataBodyRange(j) Like "DW*" Then dic_produits_MJ_desserts(clé) = "DW"
        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 correspond à 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
        Case "MJ"
'Viande toute la semaine, dessert cas le plus fréquent.
           cbNomViande.List = dic_produits_MJ_viandes.keys
'Particularités légume et dessert selon le jour de la demaine.
    Select Case JourSemaine
        'Dimanche.
        Case 7
            cbNomLégume.List = dic_produits_MJ_légumes.keys
            'Suppression valeur réservée légume deux.
            cbNomLégume.RemoveItem (0)
            cbNomDessert.List = dic_produits_MJ_desserts.keys
    End Select
    End Select
    Call RécupérationMenu
End Sub

A+ François

Bonjour Fanfan38,

Merci pour la procédure modifiée. Je vais y travailler en fin de matinée.

Bonjour, la moindre des politesses et de répondre.. Tu pourrais rajouter et dire merci

Rechercher des sujets similaires à "variable objet bloc definie"