Regénérer une feuille effacée par inadvertance

BUDGETS Messages postés 1607 Date d'inscription   Statut Membre Dernière intervention   -  
BUDGETS Messages postés 1607 Date d'inscription   Statut Membre Dernière intervention   -

Bonjour à toutes et à tous,

Impossible de retrouver le fichier dans lequel une procédure existait afin de regénérer une feuille dont le contenu aurait été effacé involontairement. Merci de me proposer une macro qui permettrait de remédier à cet inconvénient.

Bonnes journée et continuation à toutes et à tous. Prenez bien soin de vous.

https://www.transfernow.net/dl/20250725hGoN9R3O


Windows / Chrome 138.0.0.0


2 réponses

Didi64_549 Messages postés 2120 Date d'inscription   Statut Membre Dernière intervention  
 

Bonjour,

Il faut nous montrer le fichier directement car moi je ne télécharge rien sur mon P.C. qui vient de l'extérieur.

Merci par avance et bonne journée.


0
BUDGETS Messages postés 1607 Date d'inscription   Statut Membre Dernière intervention  
 

Option Explicit
'COMPTABILITÉ.xltm.
Dim Suppr As Boolean, Message As Boolean
Dim Article As String

Private Sub MasquerLégumeDeux()
'Va masquer les Intitulés (lb), les Zones de liste modifiable (cb) et les Zones de texte (tb) Légumes deux à l'ouverture du formulaire UF02 _
CréationMenus après avoir choisi une date dans le calendrier.
    lbLégumeDeux.Visible = False
    cbLégumeDeux.Visible = False
    tbCodeLégumeDeux.Visible = False
    lbPériodeLégumeDeux.Visible = False
    cbPériodeLégumeDeux.Visible = False
    tbCodePériodeLégumeDeux.Visible = False
    lbConditionnementLégumeDeux.Visible = False
    cbConditionnementLégumeDeux.Visible = False
    tbCodeConditionnementLégumeDeux.Visible = False
    lbQuantitéLégumeDeux.Visible = False
    tbQuantitéLégumeDeux.Visible = False
End Sub

Private Sub cmdRetourFeuilleAccueilAnnuler_Click()
'Va fermer le formulaireUF02CréationMenus et  retourner sur la feuille Accueil.
    Unload Me
End Sub


Private Sub tbMoisMenu_Change()
tbMoisMenu.Value = Format(DateValue(tbDateMenu.Value), "mmmm yyyy")
tbMoisMenu.Value = WorksheetFunction.Proper(Format(tbDateMenu, "mmmm, yyyy"))
End Sub

Private Sub UserForm_Activate()
'Initialisation de la Zone de liste modifiable cbNatureMenu. Va aller dans la feuille Listes, Tableau structuré TabNatureMenu et va transfé _
rer le contenu de la colonne Nature menu dans la Zone de liste modifiable cbNatureMenu de l'UserForm UF02CréationMenus.
    cbNatureMenu.List = Range("TabNatureMenu").Value
'Initialisation de la Zone de liste modifiable cbNatureMenuAllégée. Va aller dans la feuille Listes, Tableau structuré TabNatureMenuAllégée _
et va transférer le contenu de la colonne Nature menu allégée dans la Zone de liste modifiable cbNatureMenuAllégée de l'UserForm UF _
02CréationMenus.
    cbNatureMenuAllégée.List = Range("TabNatureMenuAllégée").Value
'Initialisation de la Zone de texte tbDateMenu. Va afficher le calendrier dans le formulaire UF02CréationMenus dans lequel je clique sur _
l'année concernée, le mois du menu et la date
    tbDateMenu = Format(Calendrier.Choix(tbDateMenu), "dddd d mmmm yyyy")
'Initialisation de la Zone de texte tbDateCréationMenu. Va afficher automatiquement la date du jour sous la forme Jour, Date, Mois et _
année dans la Zone de texte tbDateCréationMenu du formulaire UF02CréationMenus.
    tbDateCréationMenu = Format(Date, "dddd d mmmm yyyy")
'Initialisation de la Zone de liste modifiable cbPériodeLégumes. Va aller dans la feuille Liste, Tableau structuré TabPériodeArticlesMenus _
et va transférer le contenu de la colonne Période articles menus dans la Zone de liste modifiable cbPériodeLégume de l'UserForm UF0 _
2CréationMenus.
    cbPériodeLégumes.List = Range("TabPériodeArticlesMenus").Value
'Initialisation de la Zone de liste modifiable cbPériodeLégumeDeux. Va aller dans la feuille Liste, Tableau structuré TabPériodeArticlesMe _
nus et va transférer le contenu de la colonne Période articles menus dans la Zone de liste modifiable cbPériodeLégumeDeux de l'User _
Form UF02CréationMenus.
    cbPériodeLégumeDeux.List = Range("TabPériodeArticlesMenus").Value
'Initialisation de la Zone de liste modifiable cbPériodeViandes. Va aller dans la feuille Liste, Tableau structuré TabPériodeArticlesMenus _
et va transférer le contenu de la colonne Période articles menus dans la Zone de liste modifiable cbPériodeViandes de l'UserForm UF02 _
CréationMenus.
    cbPériodeViandes.List = Range("TabPériodeArticlesMenus").Value
'Initialisation de la Zone de liste modifiable cbPériodeDesserts. Va aller dans la feuille Liste, Tableau structuré TabPériodeArticlesMenus _
et va transférer le contenu de la colonne Période articles menus dans la Zone de liste modifiable cbPériodeDesserts de l'UserForm UF02 _
CréationMenus.
    cbPériodeDesserts.List = Range("TabPériodeArticlesMenus").Value
'Initialisation de la Zone de liste modifiable cbConditionnementLégumes. Va aller dans la feuille Liste, Tableau structuré TabConditionne _
mentArticlesMenus et va transférer le contenu de la colonne Conditionnement articles menus dans la Zone de liste modifiable cbCondi _
tionnementLégume de l'UserForm UF02 CréationMenus.
    cbConditionnementLégumes.List = Range("TabConditionnementArticlesMenus").Value
'Initialisation dela Zone de liste modifiable cbConditionnementLégumeDeux. Va aller dans la feuille Liste, Tableau structuré TabCondition _
nement ArticlesMenus et va transférer le contenu de la colonne Conditionnement articles menus dans la Zone de liste modifiable cbCondi _
tionnementLégumeDeux de l'UserForm UF02 CréationMenus.
    cbConditionnementLégumeDeux.List = Range("TabConditionnementArticlesMenus").Value
'Initialisation de la Zone de liste modifiable cbConditionnementViandes. Va aller dans la feuille Liste, Tableau structuré TabPériodeArticles _
Menus et va transférer le contenu de la colonne Conditionnement articles menus dans la Zone de liste modifiable cbConditionnementVian _
des de l'UserForm UF02 CréationMenus.
    cbConditionnementViandes.List = Range("TabConditionnementArticlesMenus").Value
'Initialisation de la Zone de liste modifiable cbConditionnementDesserts. Va aller dans la feuille Liste, Tableau structuré TabPériodeArticles _
Menus et va transférer le contenu de la colonne Conditionnement articles menus dans la Zone de liste modifiable cbConditionnementDes _
serts de l'UserForm UF02 CréationMenus.
    cbConditionnementDesserts.List = Range("TabConditionnementArticlesMenus").Value
'Initialisation de la Zone de liste modifiable cbNatureMenuAllégée. Va aller dans la feuille Liste, Tableau structuré TabNatureMenuAllégée _
et va transférer le contenu de la colonne Nature menu allégée dans la Zone de liste modifiable cbBatureMenuAllégée de l'UserForm UF _
02 CréationMenus.
    cbNatureMenuAllégée.List = Range("TabNatureMenuAllégée").Value
'Appelde la procédure MasquerLégumeDeux
    Call MasquerLégumeDeux
'Appel de la procédure MiseÀJourTitre.
    Call MiseÀJourTitre
End Sub

Sub MiseÀJourTitre()
'Va compléter l'Intitulé lbTitre avec le contenu choisi dans la Zone de liste modifiable cbNatureMenu et avec le contenu choisi dans la Zo _
ne de texte tbDateMenu.
    Me.lbTitre = "Création" & " " & LCase(cbNatureMenu) & " " & "du " & LCase(tbDateMenu) & "."
End Sub

Private Sub cbNatureMenu_Change()
Dim Tbl As Range
Dim I As Long, LastRow As Long, Cpt As Long, Nb_NatureMenuSel
Dim NatureMenuSel As String, Résult() As String

'Va remplir la Zone de texte tbCodeNatureMenu selon le contenu de la Zone de liste modifiable cbNatureMenu en allant chercher l'informa _
tion dans la feuille Listes, tableau structuré TabLégumesViandesDesserts, colonne Code nature menu et rechercher une correspondance _
avec le tableau structuré TabNatureMenu, colonne Code nature menu.
    tbCodeNatureMenu.Value = cbNatureMenu.Column(1)
'Selection de la nature menu choisie. Enregistrement dans la variable "NatureMenuSel" de la Zone de texte tbCodeNatureMenu.
    NatureMenuSel = tbCodeNatureMenu
'Nombre de caractères qui constitue cette variable.
    Nb_NatureMenuSel = Len(NatureMenuSel)
'Récupération de la plage TabLégumesViandesDesserts. Initialisation de la variable "Tbl" pour le tableau structuré TabLégumesViandes _
Desserts
    Set Tbl = Range("TabLégumesViandesDesserts")
    
'Initialisation du tableau "Résult". Dimensions maximales du tableau "Résult" avant analyse.
    ReDim Résult(1 To Tbl.Rows.Count)
'Initialisation d'un compteur à zéro.
    Cpt = 0
    
'Balayage de toute la colonne "Légumes, Viandes, Desserts" de la feuille Listes, Tableau structuré TabLégumesViandesDesserts pour en _
constituer une liste en fonction de la Nature menu sélectionnée, pour chaque ligne du tableau structuré TabLégumesViandesDesserts.
    For I = 1 To Tbl.Rows.Count
'Si les lettres de la colonne Code légumes, viandes, desserts du tableau structuré TabLégumesViandesDesserts correspondent à celles _
de la colonne Code nature menu du tableau structuré TabNatureMenu (Remarque importante : Les lettres _
de la colonne Code légumes, viandes, desserts du tableau structuré TabLégumesViandesDesserts doi _
vent être identiques aux lettres de la colonne Code nature menu du tableau structuré TabNatureMenu, si _
non la Zone de liste modifiable cbArticlesMenus reste vide.
        If Left(Tbl.Cells(I, 4).Value, Nb_NatureMenuSel) = NatureMenuSel Then
'alors, on incrémente un compteur et on mémorise l'article dans la liste Résult.
            Cpt = Cpt + 1
            Résult(Cpt) = Tbl.Cells(I, 3).Value
        End If
    Next I
    
'Résistituion de "Résult" dans les Zones de liste modifiables cbLégumes, cbLégumeDeux, cbViandes et cbDesserts. Si lecompteur est su _
périeur à zéro, c'est-à-dire que "Résult" n'est pas vide.
        If Cpt > 0 Then
'Nouvelles dimensions du tableau "Résult" obtenues.
            ReDim Preserve Résult(1 To Cpt)
'On recopie la liste des légumes, légume deux, viandes et desserts mémorisés dans "Résult" dans les Zones de liste modifiable cbLégu _
mes, cbLégume deux, cbViandes et cbDesserts.
'Select case : Exécute un des blocs d'instructions indiqués, selon la valeur d'une expression,  ici selon la valeur de NatureMenuSel.

    Select Case NatureMenuSel
        Case Is = "LMMR"
            cbLégumes.List = Résult
            'cbPériodeLégumes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 5)
        Case Is = "VMMR"
            cbViandes.List = Résult
        Case Is = "DMMR"
            cbDesserts.List = Résult
        Case Is = "LSLM"
            cbLégumes.List = Résult
        Case Is = "LSMJ"
            cbLégumes.List = Résult
        Case Is = "LSV"
            cbLégumes.List = Résult
        Case Is = "LWES"
            cbLégumes.List = Résult
        Case Is = "LWED"
            cbLégumes.List = Résult
            cbLégumeDeux.List = Résult
        Case Is = "VS"
            cbViandes.List = Résult
        Case Is = "DS"
            cbDesserts.List = Résult
        Case Is = "DWE"
            cbDesserts.List = Résult
        Case Is = "VMMWE"
            cbViandes.List = Résult 'VMMWE

    End Select
        End If
'Appel de la procédure MiseÀJourTitre.
    Call MiseÀJourTitre
End Sub

Private Sub cbNatureMenuAllégée_Change()
'Va remplir la Zone de texte tbCodeNatureMenu selon le contenu de la Zone de liste modifiable cbNatureMenu en allant chercher l'informa _
tion dans la feuille Listes, tableau structuré TabLégumesViandesDesserts, colonne Code nature menu et rechercher une correspondance _
avec le tableau structuré TabNatureMenu, colonne Code nature menu.
    tbCodeNatureMenuAllégée.Value = cbNatureMenuAllégée.Column(1)
End Sub
Private Sub cbLégumes_Change()
Dim I As Long
'Message = False
'Récupération des valeurs
'Avec la feuille Listes.
    With Sheets("Listes")
'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 ma _
tricielle 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 be _
soin de la position d'un élément dans une plage au lieu de l'élément proprement dit.
        If Suppr = True Then
'Si la suppression est demandée, alors on fait la recherche dans la feuille BD menus, tableau structuré TabBDMenus, colonne Code légu _
me.
        I = WorksheetFunction.Match(Article, Range("TabBDMenus[Code légume]"), 0)
'Si ce n'est pas une suppression, alors on fait la recherche dans la feuille Listes, tableau structuré TabLégumesViandesDesserts, colonne _
Légumes, Viandes, Desserts. Remarque importante : la ligne suivante est obligatoire sinon la Zone de liste modifiable cbPériodeLégumes _
reste vide.
        Else
            I = WorksheetFunction.Match(cbLégumes, Range("TabLégumesViandesDesserts[Légumes, Viandes, Desserts]"), 0)
        End If
        tbCodeLégumes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 4)
        cbPériodeLégumes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 5)
       tbCodePériodeLégumes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 6)
       cbConditionnementLégumes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 7)
       tbCodeConditionnementLégumes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 8)
    End With
'Va créer automatiquement le numéro création menu à partir du contenu de la Zone de liste modifiable cbNatureMenuAllégée et l'incré _
menter de 1 à chaque création d'un menu. WorksheetFunction.CountIfs : Compte le nombre de cellules à l'intérieur d'une plage qui répon _
dent à plusieurs critères.
    tbNuméroCréationMenu = tbCodeNatureMenuAllégée & "-" & Format(WorksheetFunction.CountIfs(Range("TabBDMenus[Nature menu allégée]"), _
    cbNatureMenuAllégée.Value) + 1, "00")
'Err.Number : Renvoie ou définit une valeur numérique indiquant une erreur. La propriété Number est la propriété par défaut de l'objet Err. _
Propriété en lecture-écriture.
    If Err.Number > 0 Then tbNuméroCréationMenu = cbNatureMenuAllégée.Value & "-01"
'Recherche existence menu à la datedu menu dans la feuille BD menus, tableau structuré TabBDMenus.
    I = IndiceMenus(tbCodeNatureMenuAllégée, tbDateMenu)
    If I > 0 Then
'Menu à la date menu proposée existant dans la feuille BF menus, tableau structuré TabBDMenus.
        With Range("TabBDMenus").ListObject
'Si la variable "Message" est à "False", alors on montre le message d'existence du menu à la date proposée, sinon au saute ce message.
            If Message = False Then GoTo Traitement1 Else: GoTo Traitement2
Traitement1:
'Acceptation modification ou suppression du menu. vbCrLf : dans l'aide de Microsoft Visual Basic pour Applications, dans la cadre  en _
haut à gauche, taper Constances diverses. vbCrLf : Visual Basic Caractère de saut de paragraphe. vbLf : Visual Basic Caractère de saut _
de ligne. CrLf : Visual Basic combinaison des caractères de retour de chariot et de saut de ligne. vbInformation : dans l'aide de Microsoft _
Visual Basic pour Applications, dans le cadre en haut à gauche, taper MsgBox Constances. vbInformation : Visual Basic Message d'in _
formation. vbExclamation : message d'avertissement.
'Message d'avertissement.
            If MsgBox("Le menu du " & tbDateMenu.Value & " " & "existe déjà dans la feuille BD menus, tableau structuré TabBFMenus " & _
            vbCrLf & vbCrLf & "Voulez-vous le modifier ou le supprimer ?", vbExclamation + vbYesNo) = vbYes Then
Traitement2:
'Modification acceptée : on récupére les infos menus non encore renseignées (toutes les Zones de liste modifiable et de texte concernant _
Période et conditionnement de la Zone de liste modifiable cbNatureNature et de la date menu proposé.
                cbPériodeLégumes.Value = .ListColumns("Période légume").DataBodyRange(I)
                tbCodePériodeLégumes.Value = .ListColumns("Code période légume").DataBodyRange(I)
                cbConditionnementLégumes.Value = .ListColumns("Conditionnement légume").DataBodyRange(I)
                tbCodeConditionnementLégumes.Value = .ListColumns("Code conditionnement légume").DataBodyRange(I)
                cbPériodeLégumeDeux.Value = .ListColumns("Période légume deux").DataBodyRange(I)
                tbCodePériodeLégumeDeux.Value = .ListColumns("Code période légume deux").DataBodyRange(I)
                cbConditionnementLégumeDeux.Value = .ListColumns("Conditionnement légume deux").DataBodyRange(I)
                tbCodeConditionnementLégumeDeux.Value = .ListColumns("Code conditionnement légume deux").databo(I)
                tbQuantitéLégume.Value = .ListColumns("Quantité légume").DataBodyRange(I)
                tbQuantitéLégumeDeux.Value = .ListColumns("Quantité légume deux").DataBodyRange(I)
                cbViandes.Value = .ListColumns("Viande").DataBodyRange(I)
                tbCodeViandes.Value = .ListColumns("Code viande").DataBodyRange(I)
                cbPériodeViandes.Value = .ListColumns("Période viande").DataBodyRange(I)
                tbCodePériodeViandes.Value = .ListColumns("Code période viande").DataBodyRange(I)
                cbConditionnementViandes.Value = .ListColumns("Conditionnement viande").DataBodyRange(I)
                tbCodeConditionnementViandes.Value = .ListColumns("Code conditionnement viande").DataBodyRange(I)
                tbRéférenceSemestreViandesMidiWeekend.Value = .ListColumns("Référence semestre viandes midi weekend"). _
                DataBodyRange(I)
                    End If
                End With
            Else
'Modification refusée : initialiser les infos menus.
                tbDateCréationMenu = Format(Date, "dddddd")
                tbNuméroCréationMenu.Value = tbNuméroCréationMenu.Value & "-" & "00"
            End If
'Appel de la procédure MiseÀJourTitre.
    Call MiseÀJourTitre
    Call AfficherLégumeDeux
    Message = False
End Sub

Private Sub cbLégumeDeux_Change()
 Dim I As Long
'Message = False
'Récupération des valeurs
'Avec la feuille Listes.
    With Sheets("Listes")
'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 ma _
tricielle 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 be _
soin de la position d'un élément dans une plage au lieu de l'élément proprement dit.
        If Suppr = True Then
'Si la suppression est demandée, alors on fait la recherche dans la feuille BD menus, tableau structuré TabBDMenus, colonne Code légu _
me.
        I = WorksheetFunction.Match(Article, Range("TabBDMenus[Code légume deux]"), 0)
'Si ce n'est pas une suppression, alors on fait la recherche dans la feuille Listes, tableau structuré TabLégumesViandesDesserts, colonne _
Légumes, Viandes, Desserts. Remarque importante : la ligne suivante est obligatoire sinon la Zone de liste modifiable cbPériodeLégumes _
reste vide.
        Else
            I = WorksheetFunction.Match(cbLégumeDeux, Range("TabLégumesViandesDesserts[Légumes, Viandes, Desserts]"), 0)
        End If
        tbCodeLégumeDeux = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 4)
        cbPériodeLégumeDeux = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 5)
       tbCodePériodeLégumeDeux = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 6)
       cbConditionnementLégumeDeux = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 7)
       tbCodeConditionnementLégumeDeux = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 8)
    End With
'Va créer automatiquement le numéro création menu à partir du contenu de la Zone de liste modifiable cbNatureMenuAllégée et l'incré _
menter de 1 à chaque création d'un menu. WorksheetFunction.CountIfs : Compte le nombre de cellules à l'intérieur d'une plage qui répon _
dent à plusieurs critères.
    'tbNuméroCréationMenu = tbCodeNatureMenuAllégée & "-" & Format(WorksheetFunction.CountIfs(Range("TabBDMenus[Nature menu allégée]"), _
    'cbNatureMenuAllégée.Value) + 1, "00")
'Err.Number : Renvoie ou définit une valeur numérique indiquant une erreur. La propriété Number est la propriété par défaut de l'objet Err. _
Propriété en lecture-écriture.
    'If Err.Number > 0 Then tbNuméroCréationMenu = cbNatureMenuAllégée.Value & "-01"
'Recherche existence menu à la datedu menu dans la feuille BD menus, tableau structuré TabBDMenus.
    'I = IndiceMenus(tbCodeNatureMenuAllégée, tbDateMenu)
    'If I > 0 Then
'Menu à la date menu proposée existant dans la feuille BF menus, tableau structuré TabBDMenus.
        'With Range("TabBDMenus").ListObject
'Si la variable "Message" est à "False", alors on montre le message d'existence du menu à la date proposée, sinon au saute ce message.
        '    If Message = False Then GoTo Traitement1 Else: GoTo Traitement2
Traitement1:
'Acceptation modification ou suppression du menu. vbCrLf : dans l'aide de Microsoft Visual Basic pour Applications, dans la cadre  en _
haut à gauche, taper Constances diverses. vbCrLf : Visual Basic Caractère de saut de paragraphe. vbLf : Visual Basic Caractère de saut _
de ligne. CrLf : Visual Basic combinaison des caractères de retour de chariot et de saut de ligne. vbInformation : dans l'aide de Microsoft _
Visual Basic pour Applications, dans le cadre en haut à gauche, taper MsgBox Constances. vbInformation : Visual Basic Message d'in _
formation. vbExclamation : message d'avertissement.
'Message d'avertissement.
            'If MsgBox("Le menu du " & tbDateMenu.Value & " " & "existe déjà dans la feuille BD menus, tableau structuré TabBFMenus " & _
            'vbCrLf & vbCrLf & "Voulez-vous le modifier ou le supprimer ?", vbExclamation + vbYesNo) = vbYes Then
Traitement2:
'Modification acceptée : on récupére les infos menus non encore renseignées (toutes les Zones de liste modifiable et de texte concernant _
Période et conditionnement de la Zone de liste modifiable cbNatureNature et de la date menu proposé.
                'cbPériodeLégumes.Value = .ListColumns("Période légume").DataBodyRange(I)
                'tbCodePériodeLégumes.Value = .ListColumns("Code période légume").DataBodyRange(I)
                'cbConditionnementLégumes.Value = .ListColumns("Conditionnement légume").DataBodyRange(I)
                'tbCodeConditionnementLégumes.Value = .ListColumns("Code conditionnement légume").DataBodyRange(I)
                'cbPériodeLégumeDeux.Value = .ListColumns("Période légume deux").DataBodyRange(I)
                'tbCodePériodeLégumeDeux.Value = .ListColumns("Code période légume deux").DataBodyRange(I)
                'cbConditionnementLégumeDeux.Value = .ListColumns("Conditionnement légume deux").DataBodyRange(I)
                'tbCodeConditionnementLégumeDeux.Value = .ListColumns("Code conditionnement légume deux").databo(I)
                'tbQuantitéLégume.Value = .ListColumns("Quantité légume").DataBodyRange(I)
                'tbQuantitéLégumeDeux.Value = .ListColumns("Quantité légume deux").DataBodyRange(I)
                'cbViandes.Value = .ListColumns("Viande").DataBodyRange(I)
                'tbCodeViandes.Value = .ListColumns("Code viande").DataBodyRange(I)
                'cbPériodeViandes.Value = .ListColumns("Période viande").DataBodyRange(I)
                'tbCodePériodeViandes.Value = .ListColumns("Code période viande").DataBodyRange(I)
                'cbConditionnementViandes.Value = .ListColumns("Conditionnement viande").DataBodyRange(I)
                'tbCodeConditionnementViandes.Value = .ListColumns("Code conditionnement viande").DataBodyRange(I)
                'tbRéférenceSemestreViandesMidiWeekend.Value = .ListColumns("Référence semestre viandes midi weekend"). _
                'DataBodyRange(I)
                    'End If
                'End With
            'Else
'Modification refusée : initialiser les infos menus.
                'tbDateCréationMenu = Format(Date, "dddddd")
                'tbNuméroCréationMenu.Value = tbNuméroCréationMenu.Value & "-" & "00"
            'End If
'Appel de la procédure MiseÀJourTitre.
    'Call MiseÀJourTitre
    'Call AfficherLégumeDeux
    'Message = False
End Sub

Private Sub cbViandes_Change()
Dim I As Long
'Message = False
'Récupération des valeurs
'Avec la feuille Listes.
    With Sheets("Listes")
'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 ma _
tricielle 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 be _
soin de la position d'un élément dans une plage au lieu de l'élément proprement dit.
        If Suppr = True Then
'Si la suppression est demandée, alors on fait la recherche dans la feuille BD menus, tableau structuré TabBDMenus, colonne Code légu _
me.
        I = WorksheetFunction.Match(Article, Range("TabBDMenus[Code viande]"), 0)
'Si ce n'est pas une suppression, alors on fait la recherche dans la feuille Listes, tableau structuré TabLégumesViandesDesserts, colonne _
Légumes, Viandes, Desserts. Remarque importante : la ligne suivante est obligatoire sinon la Zone de liste modifiable cbPériodeLégumes _
reste vide.
        Else
            I = WorksheetFunction.Match(cbViandes, Range("TabLégumesViandesDesserts[Légumes, Viandes, Desserts]"), 0)
        End If
        tbCodeViandes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 4)
        cbPériodeViandes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 5)
       tbCodePériodeViandes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 6)
       cbConditionnementViandes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 7)
       tbCodeConditionnementViandes = Range("TabLégumesViandesDesserts").ListObject.DataBodyRange(I, 8)
    End With
'Va créer automatiquement le numéro création menu à partir du contenu de la Zone de liste modifiable cbNatureMenuAllégée et l'incré _
menter de 1 à chaque création d'un menu. WorksheetFunction.CountIfs : Compte le nombre de cellules à l'intérieur d'une plage qui répon _
dent à plusieurs critères.
    'tbNuméroCréationMenu = tbCodeNatureMenuAllégée & "-" & Format(WorksheetFunction.CountIfs(Range("TabBDMenus[Nature menu allégée]"), _
    'cbNatureMenuAllégée.Value) + 1, "00")
'Err.Number : Renvoie ou définit une valeur numérique indiquant une erreur. La propriété Number est la propriété par défaut de l'objet Err. _
Propriété en lecture-écriture.
    'If Err.Number > 0 Then tbNuméroCréationMenu = cbNatureMenuAllégée.Value & "-01"
'Recherche existence menu à la date du menu dans la feuille BD menus, tableau structuré TabBDMenus.
    I = IndiceMenus(tbCodeNatureMenuAllégée, tbDateMenu)
    If I > 0 Then
'Menu à la date menu proposée existant dans la feuille BF menus, tableau structuré TabBDMenus.
        With Range("TabBDMenus").ListObject
'Si la variable "Message" est à "False", alors on montre le message d'existence du menu à la date proposée, sinon au saute ce message.
            If Message = False Then GoTo Traitement1 Else: GoTo Traitement2
Traitement1:
'Acceptation modification ou suppression du menu. vbCrLf : dans l'aide de Microsoft Visual Basic pour Applications, dans la cadre  en _
haut à gauche, taper Constances diverses. vbCrLf : Visual Basic Caractère de saut de paragraphe. vbLf : Visual Basic Caractère de saut _
de ligne. CrLf : Visual Basic combinaison des caractères de retour de chariot et de saut de ligne. vbInformation : dans l'aide de Microsoft _
Visual Basic pour Applications, dans le cadre en haut à gauche, taper MsgBox Constances. vbInformation : Visual Basic Message d'in _
formation. vbExclamation : message d'avertissement.
'Message d'avertissement.
            'If MsgBox("Le menu du " & tbDateMenu.Value & " " & "existe déjà dans la feuille BD menus, tableau structuré TabBFMenus " & _
            'vbCrLf & vbCrLf & "Voulez-vous le modifier ou le supprimer ?", vbExclamation + vbYesNo) = vbYes Then
Traitement2:
'Modification acceptée : on récupére les infos menus non encore renseignées (toutes les Zones de liste modifiable et de texte concernant _
Période et conditionnement de la Zone de liste modifiable cbNatureNature et de la date menu proposé.
                cbPériodeLégumes.Value = .ListColumns("Période légume").DataBodyRange(I)
                tbCodePériodeLégumes.Value = .ListColumns("Code période légume").DataBodyRange(I)
                cbConditionnementLégumes.Value = .ListColumns("Conditionnement légume").DataBodyRange(I)
                tbCodeConditionnementLégumes.Value = .ListColumns("Code conditionnement légume").DataBodyRange(I)
                cbPériodeLégumeDeux.Value = .ListColumns("Période légume deux").DataBodyRange(I)
                tbCodePériodeLégumeDeux.Value = .ListColumns("Code période légume deux").DataBodyRange(I)
                cbConditionnementLégumeDeux.Value = .ListColumns("Conditionnement légume deux").DataBodyRange(I)
                tbCodeConditionnementLégumeDeux.Value = .ListColumns("Code conditionnement légume deux").databo(I)
                tbQuantitéLégume.Value = .ListColumns("Quantité légume").DataBodyRange(I)
                tbQuantitéLégumeDeux.Value = .ListColumns("Quantité légume deux").DataBodyRange(I)
                cbViandes.Value = .ListColumns("Viande").DataBodyRange(I)
                tbCodeViandes.Value = .ListColumns("Code viande").DataBodyRange(I)
                cbPériodeViandes.Value = .ListColumns("Période viande").DataBodyRange(I)
                tbCodePériodeViandes.Value = .ListColumns("Code période viande").DataBodyRange(I)
                cbConditionnementViandes.Value = .ListColumns("Conditionnement viande").DataBodyRange(I)
                tbCodeConditionnementViandes.Value = .ListColumns("Code conditionnement viande").DataBodyRange(I)
                tbRéférenceSemestreViandesMidiWeekend.Value = .ListColumns("Référence semestre viandes midi weekend"). _
                DataBodyRange(I)
                    
                End With
            Else
'Modification refusée : initialiser les infos menus.
                tbDateCréationMenu = Format(Date, "dddddd")
                tbNuméroCréationMenu.Value = tbNuméroCréationMenu.Value & "-" & "00"
            End If
'Appel de la procédure MiseÀJourTitre.
    Call MiseÀJourTitre
    Call AfficherLégumeDeux
    Message = False

End Sub
Private Sub AfficherLégumeDeux()
    lbLégumeDeux.Visible = True
    cbLégumeDeux.Visible = True
    tbCodeLégumeDeux.Visible = True
    lbPériodeLégumeDeux.Visible = True
    cbPériodeLégumeDeux.Visible = True
    tbCodePériodeLégumeDeux.Visible = True
    lbConditionnementLégumeDeux.Visible = True
    cbConditionnementLégumeDeux.Visible = True
    tbCodeConditionnementLégumeDeux.Visible = True
    lbQuantitéLégumeDeux.Visible = True
    tbQuantitéLégumeDeux.Visible = True
End Sub
Private Function IndiceMenus(ByVal CodeNatureMenuAllégée As String, ByVal DateMenu As String) As Long
'Renvoie l'indice du menu dans la feuille BD menus, tab keau structuré TabBDMenus pour le code menu donné si il existe, renvoie zéro si _
le code menu est inexistant.
    IndiceMenus = 0
'On ErrorRésume Next : Lorsqu'une erreur d'exécution survient, le contrôle est transmis à l'instruction qui suit immédiatement celle où l'er _
reur s'est produite, et l'exécution continue. Il est recommandé d'utiliser cette formulation plutôt que l'instruction On Error GoTo pour ac _
céder à des objets.
    On Error Resume Next
    IndiceMenus = WorksheetFunction.Match(tbCodeNatureMenuAllégée, Range("TabBDMenus[Date menu]"), 0)
'On Error GoTo 0 : Invalide dans la procédure en cours tout gestionnaire d'erreurs validé.
    On Error GoTo 0
End Function

Private Sub cmdValidationCréationMenu_Click()
Dim I As Long
'Si le menu à la date proposée n'existe pas, on ne fait rien et on sort de la procédure.
    If cbNatureMenuAllégée.ListIndex = -1 Then Exit Sub
    
'Recherche IndiceMenus.
    I = IndiceMenus(tbCodeNatureMenuAllégée.Value, tbDateMenu)
    
    With Range("TabBDMenus").ListObject
        If I = 0 Then
'Menu à la date proposée non trouvé : ajout d'une ligne à la fin du tableau structuré TabBDMenus. ListRowsAdd : Ajoute une nouvelle li _
gne à la table représentée par l'objet ListObject spécifié.
            .ListRows.Add
'ListRows.Count : cette proproété renvoie une valeur de type Integer qui représente le nombre d'objets dans la collection.
            I = .ListRows.Count
        End If
'Insertion des données saisies dans le formulaire UF02CréationMenus (objet) vers la feuille BD menus, tableau structuré TabBDMenus. _
.ListColumns : cette propriété renvoie une collection ListColums qui représente toutes les colonnes d'un objet ListObject. Type de don _
nées en lecture seule. DataBodyRange : Cette propriété renvoie un objet Range qui représente la plage de valeurs, à l'exception de la li _
gne d'en-tête dans une table. Type de données en lecture seule. Nature menu : nom de la colonne dans la feuille BD menus, tableau _
structuré TabBDMenus. cbNatureMenu.Value : nom de l'objet dans le formulaire UF02CréationMenus (Objet).
        .ListColumns("Nature menu").DataBodyRange(I) = cbNatureMenuAllégée.Value
        .ListColumns("Code nature menu").DataBodyRange(I) = tbCodeNatureMenuAllégée.Value
        .ListColumns("Date menu").DataBodyRange(I) = tbDateMenu.Value
        .ListColumns("Date création menu").DataBodyRange(I) = tbDateCréationMenu.Value
        .ListColumns("Légume").DataBodyRange(I) = cbLégumes.Value
        .ListColumns("Code légume").DataBodyRange(I) = tbCodeLégumes.Value
        .ListColumns("Période légume").DataBodyRange(I) = cbPériodeLégumes.Value
        .ListColumns("Code période légume").DataBodyRange(I) = tbCodePériodeLégumes.Value
        .ListColumns("Conditionnement légume").DataBodyRange(I) = cbConditionnementLégumes.Value
        .ListColumns("Code conditionnement légume").DataBodyRange(I) = tbCodeConditionnementLégumes.Value
        .ListColumns("Légume deux").DataBodyRange(I) = cbLégumeDeux.Value
        .ListColumns("Code légume deux").DataBodyRange(I) = tbCodeLégumeDeux.Value
        .ListColumns("Période légume deux").DataBodyRange(I) = cbPériodeLégumeDeux.Value
        .ListColumns("Code période légume deux").DataBodyRange(I) = tbCodePériodeLégumeDeux.Value
        .ListColumns("Conditionnement légume deux").DataBodyRange(I) = cbConditionnementLégumeDeux.Value
        .ListColumns("Code conditionnement légume deux").DataBodyRange(I) = tbCodeConditionnementLégumeDeux.Value
        .ListColumns("Quantité légume").DataBodyRange(I) = tbQuantitéLégume.Value
        .ListColumns("Quantité légume deux").DataBodyRange(I) = tbQuantitéLégumeDeux.Value
        .ListColumns("Viande").DataBodyRange(I) = cbViandes.Value
        .ListColumns("Code viande").DataBodyRange(I) = tbCodeViandes.Value
        .ListColumns("Période viande").DataBodyRange(I) = cbPériodeViandes.Value
        .ListColumns("Code période viande").DataBodyRange(I) = tbCodePériodeViandes.Value
        .ListColumns("Conditionnement viande").DataBodyRange(I) = cbConditionnementViandes.Value
        .ListColumns("Code conditionnement viande").DataBodyRange(I) = tbCodeConditionnementViandes.Value
        .ListColumns("Quantité viande").DataBodyRange(I) = tbQuantitéViandes.Value
        .ListColumns("Référence semestre viandes midi weekend").DataBodyRange(I) = tbRéférenceSemestreViandesMidiWeekend.Value
        .ListColumns("Dessert").DataBodyRange(I) = cbDesserts.Value
        .ListColumns("Code dessert").DataBodyRange(I) = tbCodeDesserts.Value
        .ListColumns("Période dessert").DataBodyRange(I) = cbPériodeDesserts.Value
        .ListColumns("Code période dessert").DataBodyRange(I) = tbCodePériodeDesserts.Value
        .ListColumns("Conditionnement dessert").DataBodyRange(I) = cbConditionnementDesserts.Value
        .ListColumns("Code conditionnement dessert").DataBodyRange(I) = tbCodeConditionnementDesserts.Value
        .ListColumns("Quantité dessert").DataBodyRange(I) = tbQuantitéDesserts.Value
        .ListColumns("Numéro création menu").DataBodyRange(I) = tbNuméroCréationMenu.Value
        .ListColumns("Nom jour férié").DataBodyRange(I) = tbJoursFériés.Value
        .ListColumns("Mois menu").DataBodyRange(I) = tbMoisMenu.Value
        .ListColumns("Nature menu allégée").DataBodyRange(I) = cbNatureMenuAllégée.Value
        .ListColumns("Code nature menu allégée").DataBodyRange(1) = tbCodeNatureMenuAllégée.Value
'Trier la feuille  BD menus, tableau structuré TabBDMenus, par code nature menu allégée et par date. Range.Sort key1 : désigne le pre _
mier champ du tri, soit sous forme de chaîne de nom de plage, soit sous forme d'objet. .Range : détermine les valeurs à trier. Hea _
der:=xlYes : La plage entière ne doit pas être triée.
        .Range.Sort key1:=.ListColumns("Code nature menu allégée"), key2:=.ListColumns("Date menu"), Header:=xlYes
'Appel de la procédure ModifierNuméroCréationMenu.
    Call ModifierNuméroCréationMenu
    I = IndiceMenus(tbCodeNatureMenuAllégée.Value, tbDateMenu.Value)
    tbNuméroCréationMenu.Value = .ListColumns("Numéro création menu").DataBodyRange(I)
    End With
End Sub

Private Sub ModifierNuméroCréationMenu()
Dim I As Long, K As Long
    With Range("TabBDMenus").ListObject
        K = 1
        For I = 1 To .ListRows.Count
'Si la valeur code nature menu allégée de l'élément N de la feuille BD menus, tableau structuré TabBDMenus, est identique à la Zone de _
texte tbCodeNatureMenuAllégéé, alors on modifie l'élément.
            If .ListColumns("Code nature menu allégée").DataBodyRange(I) = tbCodeNatureMenuAllégée.Value Then
                .ListColumns("Numéro création menu").DataBodyRange(I) = tbCodeNatureMenuAllégée.Value & "-" & Format(K, "00")
                K = K + 1
            End If
        Next I
    End With
End Sub
 

Les colonnes de la feuille BD articles menus ;

Catégorie articles menusCode catégorie articles menusArticles menusCode articles menusPériode articles menusCode période articles menusConditionnement articles menusCode conditionnement articles menusDate création articles menusNuméro création articles menus

Les colones de la feuille BD menus :

Nature menuCode nature menuDate menuDate création menuLégumeCode légumePériode légumeCode période légumeConditionnement légumeCode conditionnement légumeLégume deuxCode légume deuxPériode légume deuxCode période légume deuxConditionnement légume deuxCode conditionnement légume deuxQuantité légumeQuantité légume deuxViandeCode viandePériode viandeCode période viandeConditionnement viandeCode conditionnement viandeQuantité viandeRéférence semestre viandes midi weekendDessertCode dessertPériode dessertCode période dessertConditionnement dessertCode conditionnement dessertQuantité dessertNuméro création menuNom jour fériéMois menuIdentifiant menuCode ID menuNature menu allégéeCode nature menu allégée


0