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

Résolu/Fermé
BUDGETS Messages postés 1337 Date d'inscription samedi 19 juillet 2014 Statut Membre Dernière intervention 4 mai 2024 - Modifié le 15 janv. 2023 à 22:54
Le Pingou Messages postés 12069 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 6 mai 2024 - 15 janv. 2023 à 22:41

Bonjour à toutes et à tous,

Mes meilleurs vœux d'heureuse année et de bonne santé à toutes et à tous, tant pour vous que pour vos familles. Que vos vœux les plus fous soient exaucés.

UserForm UF01_Création : procédure cbNomArticleMenu_Change : il est prévu des instructions pour recherche existence article qui appelle la procédure RécupérationArticlesMenus; dans cette procédure, il est également prévu des instructions pour  recherche existence article qui signale qu'une instruction doit être exécutée si l'article est existant et  qui fait un appel à la procédure  RécupérationInfosArticlesMenus qui, alors, doit faire apparaître les cb tels qu'ils ont été prévus dans ladite procédure. Or, le message d'existence ne s'exécute pas quand je choisis un article existant.

D'avance merci pour l'aide que vous voudrez bien m'apporter.

Quand cjoint sera redisponible, je vous joindrai le fichier.

Comme le site cjoint semble ne pas fonctionner, voici les procédures :

Private Sub cbNomArticleMenu_Change()
Dim lig As Integer
'Effacer le contenu des cb et des tb si cbNomArticleMenu est vide.
    If cbNomNatureArticleMenu.Value = "" Then
        tbCodeNatureArticleMenu.Value = ""
        cbNomArticleMenu.Value = ""
        tbCodeArticleMenu.Value = ""
        tbDateCréationArticleMenu.Value = ""
        tbNuméroCréationArticleMenu.Value = ""
    End If
    
    With sh02.ListObjects("TabProduits")
'Va aller dans la colonne 1 du tableau structuré TabProduits pour chercher une correspondance avec le nom nature article menu et, si correspondance trouvée, va copier le con_
'tenu de la colonne 2 du tableau structuré TabProduits. .ListColumns : bien mettre 1 et cbNomArticleMenu. Va permettre d'écrire le code de l'article menu choisi dans le cbNom-
'ArticleMenu.
        lig = .ListColumns(1).DataBodyRange.Find(cbNomArticleMenu, LookIn:=xlValues, lookat:=xlWhole).Row - .HeaderRowRange.Row
            tbCodeArticleMenu = .DataBodyRange.Item(lig, 2).Value
    End With
'Prédéfinition des cbNomPériodeArticleMenu et cbNomConditionnementArticleMenu. Va permettre de remplir automatiquement ces deux zones de liste modifiable.
'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 cbNomNatureArticleMenu.Value
        Case Is = "Dessert midi retraite"
            cbNomPériodeArticleMenu.Value = "Lundi à vendredi midis"
            cbNomConditionnementArticleMenu.Value = "1 sachet de 2 kilogrammes. 1 pomme pour 1 repas"
        Case Is = "Dessert soir"
            cbNomPériodeArticleMenu.Value = "Lundi à vendredi soirs"
            cbNomConditionnementArticleMenu.Value = "1 sachet de 2 kilogrammes. 1 pomme pour 1 repas"
        Case Is = "Desserts weekend"
            cbNomPériodeArticleMenu.Value = "Samedi et dimanche midis et soirs"
'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 cbNomArticleMenu.Value
        Case Is = "Ananas": cbNomConditionnementArticleMenu.Value = "Unité : 1 pour 4 repas"
        Case Is = "Autres fruits", "Clémentines", "Fruits de saison": cbNomConditionnementArticleMenu.Value = "2 à 4 pour 1 repas"
        Case Is = "Avocats", "Bananes", "Oranges": cbNomConditionnementArticleMenu.Value = "Unité : 1 pour 1 repas"
        Case Is = "Dattes", "Figues", "Pruneaux": cbNomConditionnementArticleMenu.Value = "1 paquet pour 4 repas"
        Case Is = "Fruits au sirop", "Gâteaux samedi dimanche": cbNomConditionnementArticleMenu.Value = "1 boîte pour 2 repas"
        Case Is = "Petits suisses": cbNomConditionnementArticleMenu.Value = "1 pack de 6 pots. 3 pots pour 1 repas"
        Case Is = "Tapioca": cbNomConditionnementArticleMenu.Value = "25 grammes pour 1 repas"
        Case Else: cbNomConditionnementArticleMenu.Value = "1 pack de 4 pots pour le weekend. 1 pot pour 1 repas"
       End Select
        Case Is = "Légumes midi retraite"
            cbNomPériodeArticleMenu.Value = "Lundi à vendredi midis"
'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 cbNomArticleMenu.Value
        Case Is = "Asperges", "Champignons": cbNomConditionnementArticleMenu.Value = "1 boîte pour 1 repas"
        Case Is = "Carottes", "Tomates": cbNomConditionnementArticleMenu.Value = "2 pour 1 repas"
        Case Is = "Céleri": cbNomConditionnementArticleMenu.Value = "1 branche pour 1 repas"
        Case Is = "Couscous", "Purée", "Riz": cbNomConditionnementArticleMenu.Value = "25 grammes pour 1 repas"
        Case Is = "Maïs": cbNomConditionnementArticleMenu.Value = "1 boîte pour 2 repas"
        Case Is = "Pâtes à la sauce tomates", "Pâtes au beurre": cbNomConditionnementArticleMenu.Value = "5 cuillères pour 1 repas"
        Case Is = "Radis": cbNomConditionnementArticleMenu.Value = "1 botte ou 1 sachet pour 2 repas"
        Case Is = "Salade": cbNomConditionnementArticleMenu.Value = "Unité : 1 tête pour 1 repas"
        Case Else: cbNomConditionnementArticleMenu.Value = "Unité : 1 pour 1 repas"
    End Select
        Case Is = "Légumes soirs lundi mardi"
            cbNomPériodeArticleMenu.Value = "Lundi et mardi soirs"
'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 cbNomArticleMenu.Value
        Case Is = "Chou-fleur": cbNomConditionnementArticleMenu.Value = "1 pour 2 repas"
        Case Is = "Couscous", "Purée", "Riz": cbNomConditionnementArticleMenu.Value = "25 grammes pour 1 repas"
        Case Is = "Poireau", "Pomme de terre": cbNomConditionnementArticleMenu.Value = " pour 1 repas"
        Case Else: cbNomConditionnementArticleMenu.Value = "1 boîte pour 2 repas"
    End Select
        Case Is = "Légumes soirs mercredi jeudi"
            cbNomPériodeArticleMenu.Value = "Mercredi et jeudi soirs"
                cbNomConditionnementArticleMenu.Value = "1 boîte pour 2 repas"
        Case Is = "Légumes soirs vendredi"
            cbNomPériodeArticleMenu.Value = "Vendredi soir"
'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 cbNomArticleMenu.Value
        Case "Asperges", "Champignons", "Salsifis": cbNomConditionnementArticleMenu.Value = "1 boîte pour 1 repas"
        Case "Betterave rouge": cbNomConditionnementArticleMenu.Value = "1 paquet pour 5 repas"
        Case "Carottes", "Tomates": cbNomConditionnementArticleMenu.Value = "Unité : 2 pour 1 repas"
        Case "Céleri": cbNomConditionnementArticleMenu.Value = "Unité : 1 branche pour 1 repas"
        Case "Radis": cbNomConditionnementArticleMenu.Value = "1 botte ou 1 sachet pour 1 repas"
        Case "Salade": cbNomConditionnementArticleMenu.Value = "Unité : 1 tête pour 1 repas"
        Case Else: cbNomConditionnementArticleMenu.Value = "Unité : 1 pour 1 repas"
    End Select
        Case Is = "Légumes weekend samedi"
            cbNomPériodeArticleMenu.Value = "Samedi midi et soir": cbNomConditionnementArticleMenu.Value = "5 cuillères pour 1 repas"
                cbNomConditionnementArticleMenu.Value = "5 cuillères pour 1 repas"
        Case Is = "Légumes weekend dimanche"
 '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 cbNomArticleMenu.Value
            Case "Asperges": cbNomPériodeArticleMenu.Value = "Dimanche soir": cbNomConditionnementArticleMenu.Value = "1 boîte pour 1 repas"
            Case "Chips": cbNomPériodeArticleMenu.Value = "Dimanche midi et soir": cbNomConditionnementArticleMenu.Value = "1 sachet pour 2 repas"
            Case "Frites": cbNomPériodeArticleMenu.Value = "Dimanche midi": cbNomConditionnementArticleMenu.Value = "20 frites pour 1 repas"
            Case "Haricots verts": cbNomPériodeArticleMenu.Value = "Dimanche midi et soir": cbNomConditionnementArticleMenu.Value = "1 boîte pour 2 repas"
    End Select
        Case Is = "Viande menu midi retraite"
            cbNomPériodeArticleMenu.Value = "Lundi à vendredi midis"
                cbNomConditionnementArticleMenu.Value = "1 morceau de 500 grammes pour 5 repas"
        Case Is = "Viande menu midi weekend"
            cbNomPériodeArticleMenu.Value = "Samedi et dimanche midis"
'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 cbNomArticleMenu.Value
        Case "Poisson": cbNomConditionnementArticleMenu.Value = "Unité : 1 pour 1 repas"
            Case Else: cbNomConditionnementArticleMenu.Value = "1 tranche pour 1 repas"
    End Select
        Case Is = "Viande menu soir"
'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 cbNomArticleMenu.Value
        Case "Viande cassoulet", "Viande choucroute", "Viande paella": cbNomPériodeArticleMenu.Value = "Lundi et mardi soirs"
            Case Else: cbNomPériodeArticleMenu.Value = "Lundi à dimanche soirs"
    End Select
'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 cbNomArticleMenu.Value
        Case "Bifteck haché de cheval": cbNomConditionnementArticleMenu.Value = "125 grammes pour 1 repas"
        Case "Bouchée à la reine", "Croque-monsieur", "Roulé au fromage", "Viande cassoulet", "Viande choucroute", "Viande paella": cbNomConditionnementArticleMenu.Value = "1 boîte pour 2 repas"
        Case "Fromage de tête", "Tête persillée": cbNomConditionnementArticleMenu.Value = "1 tranche pour 2 repas"
        Case "Œufs": cbNomConditionnementArticleMenu.Value = "1 boîte de 6 œufs. 3 œufs pour 1 repas"
        Case "Poisson": cbNomConditionnementArticleMenu.Value = "Unité : 1 pour 1 repas"
        Case "Roulade à la pistache", "Tête roulée": cbNomConditionnementArticleMenu.Value = "3 tranches pour 1 repas"
        Case "Saucisson": cbNomConditionnementArticleMenu.Value = "1 sachet pour 6 repas. 5 tranches par repas"
        Case "Thon": cbNomConditionnementArticleMenu.Value = "1 boîte^pour 1 repas"
        Case Else: cbNomConditionnementArticleMenu.Value = "1 paquet pour 2 repas"
    End Select
End Select
'Recherche existence article.
Dim i As Long
    i = IndiceArticlesMenus(cbNomArticleMenu.Value) 'IndiceNom articlemenu dans la feuille BD articles menus, tableau structuré TabBDArticlesMenus.
'Si i supérieur à zéro alors.
    If i > 0 Then
    'Article trouvé.
    Call RécupérationArticlesMenus(i)
    End If

Sub RécupérationArticlesMenus(ByVal i As Long)
Dim j As Integer
'Recherche existence article.
'IndiceArticlesMenus : indice articles menus dans la feuille BD articles menus, tableau structuré TabArticlesMenus.
    i = IndiceArticlesMenus(cbNomArticleMenu)
'Si i>supérieur à zéro alors
    If i > 0 Then
'Article existant dans la feuille BD articles menus, tableau structuré TabArticlesMenus : va aller dans la procédure Sub RécupérationInfosArticlesMenus.
    MsgBox "L'article " & cbNomArticleMenu.Value & " existe déjà dans la feuille BD articles menus, tableau structuré TabBDArticlesMenus." & vbCrLf & vbCrLf & _
    "Vous pouvez le modifier ou le supprimer.", vbInformation
        Call RécupérationInfosArticlesMenus(i)
        j = i
    End If
End Sub
Sub RécupérationInfosArticlesMenus(ByVal i As Long)
'Le programme va remplir les combo boxes et les zones de texte correspondants de l'UserForm UF01_Création en allant chercher les informations adéquates dans la feuille BD
'articles menus, tableau structuré TabBDArticlesMenus (Indice i).
    cbNomNatureCréation.Value = Range("TabBDArticlesMenus[Nom nature création]").Item(i)
    cbNomNatureArticleMenu.Value = Range("TabBDArticlesMenus[Nom nature article menu]").Item(i)
    cbNomArticleMenu.Value = Range("TabBDArticlesMenus[Nom article menu]").Item(i)
    cbNomPériodeArticleMenu.Value = Range("TabBDArticlesMenus[Nom période article menu]").Item(i)
    cbNomConditionnementArticleMenu.Value = Range("TabBDArticlesMenus[Nom conditionnement article menu]").Item(i)
    tbDateCréationArticleMenu.Value = Range("TabBDArticlesMenus[Date création article menu]").Item(i)
    tbNuméroCréationArticleMenu.Value = Range("TabBDArticlesMenus[Numéro création article menu]").Item(i)
End Sub
Private Function IndiceArticlesMenus(ByVal cbNomArticleMenu As String) As Long
Dim cel As Range
'Renvoie l'indice de l'article dans la feuille BD articles menus, tableau structuré TabBDArticlesMenus pour le cbNomArticleMenu défini si l'article existe. Renvoie zéro si l'article
'n'existe pas.
    IndiceArticlesMenus = 0
'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
   For Each cel In Range("TabBDArticlesMenus[Nom nature article menu]")
        If cel.Value & cel.Offset(0, 1).Value = cbNomNatureArticleMenu & cbNomArticleMenu Then
            IndiceArticlesMenus = cel.Row - sh03.Range("TabBDArticlesMenus").ListObject.HeaderRowRange.Row
            If IndiceArticlesMenus > 0 Then Exit For
        End If
    Next cel
'Invalide dans la procédure en cours tout gestionnaire d'erreurs validé
    On Error GoTo 0
End Function

https://www.cjoint.com/c/MAppm6J8zt8
Windows / Chrome 109.0.0.0


1 réponse

Le Pingou Messages postés 12069 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 6 mai 2024 1 431
15 janv. 2023 à 22:41

Bonsoir, 

Je peux vous signaler ou se trouve une erreur ,mais je ne sait pas la corriger


0