création fiches recettes et ingrédients

[czac]

Bonjour,

je suis en train de créer un fichier pour la création de fiches recettes en lien avec des ingrédients. j'ai mis des notes sur le fichier concernant différents points où je bloque. Serait-il possible de m'aider sur ce sujet. ci-joint le fichier

un grand merci

cordialement

 

[vgendron]

Voici

Sub creation_nouvelle_recette()
' creation_nouvelle_recette Macro
'
Application.ScreenUpdating = False
'
nbfeuilles = ActiveWorkbook.Sheets.Count 'on compte le nombre de feuilles dans le classeur
NomRecette = Sheets("Page de garde").Range("D18") 'on récupère le nom de la recette
NomRayon = Range("N18")
With Sheets("Repertoire") 'on va voir si la recette existe déjà
   'fin = .Range("C" & Rows.Count).End(xlUp).Row
   Set c = .Range("C8:E" & .Range("C" & .Rows.Count).End(xlUp).Row).Find(NomRecette, Lookat:=xlWhole)
    If Not c Is Nothing Then
        MsgBox ("cette recette existe déjà!")
        Exit Sub
    End If
    NumLastDoc = .Range("A" & .Rows.Count).End(xlUp) 'nom du dernier doc présent dans la feuille Repertoire
End With

If NumLastDoc = "N° du document" Then
    NumNewDoc = "FAB." & NomRayon & ".01"
ElseIf CInt(Mid(NumLastDoc, 5, 2)) <> NomRayon Then
    NumNewDoc = "FAB." & NomRayon & ".01"
Else
    NumNewDoc = Left(NumLastDoc, 7) & Format(CInt(Right(NumLastDoc, 2)) + 1, "00")
End If
Range("D18:H19").ClearContents 'on efface avant de continuer
Range("N18:O19").ClearContents 'on efface avant de continuer


With Sheets("Repertoire")
    .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = NumNewDoc 'on ecrit le nouveau numéro en fin de liste
    .Range("A" & .Rows.Count).End(xlUp).Offset(0, 1) = NomRecette 'on ecrit le nom de la recette à coté en colonne B
    .Range("F" & .Range("A" & .Rows.Count).End(xlUp).Row).Resize(1, 14).Formula = "=ListeAllergènes($A" & .Range("A" & .Rows.Count).End(xlUp).Row & ")"
End With

Sheets("FAB modele").Copy After:=Worksheets(nbfeuilles) 'on copie le FAB Modele
With ActiveSheet
    .Name = NumNewDoc 'on lui donne le nom avec N° de doc
    .Range("H3") = NumNewDoc 'qu'on réécrit en H3
    .Range("B3") = NomRecette 'et nom de la recette en B3
End With
   
   
'création du lien hypertexte
With Sheets("Repertoire")
    .Activate
    .Range("A" & .Rows.Count).End(xlUp).Select
    .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        NumNewDoc & "!A1", TextToDisplay:=NumNewDoc
End With
Sheets(NumNewDoc).Activate
Application.ScreenUpdating = True
End Sub

 

[czac]

super, cela a l'air de fonctionner

merci

 

[sid1969]

Hello!
Voir PJ pour correction
j'en ai profité pour faire le tri dans les différents modules ainsi que codes qui à priori ne servent plus à rien.. Dans le doute, je les ai mis en commentaire

j'ai aussi ajouté des commentaires cà et là pour expliquer les codes

 

[sid1969]

Bonjour,
je commence un travail sur les allergènes , et j'aimerais m'inspirer et adapter ce beau travail , comment je peut procéder pour transposer ce fichier ?
Sid

 

[sandchat]

j'ai modifier dans VBA pour la date et cela fonctionne yes lol. Voilà le dernier fichier

Bonjour
Merci pour ce tableau qui est génial !
Pourriez vous m'aider à faire quelques modifications ?

Dans la feuille 'liste des ingrédients" je peux avoir un même produit venant de deux fournisseurs différents, mais pas forcément au même prix.
Est il possible dans la feuille "fiche recette" : je choisit dans la liste déroulante mon 1er ingrédient, dans une autre cellule je choisit le fournisseur dans une liste déroulante, et le prix se met à jour ?
Je vous remercie pour votre aide...
je vous joint à nouveau le ficher au cas ou