Fiche technique interactive
Bonjour a tous,
je vous sollicite, car je cherche a rendre ce modèle de fiche technique interactive. C'est-a-dire que j'aimerais que les cellules D15 à H50 se divisent ou se multiplient automatiquement selon la cellule I2 qui détermine pour combien de couvert et la fiche technique.
Exemple: Si je réalise une fiche technique sur l'éclat de chocolat Gianduja pour 10 couverts en I2 (fichier à disposition) alors j'aurai besoin de 0.400 kg de sorbet mandarine.
Si maintenant je change la valeur de I2 en 20 (pour 20 couverts) j'aimerais que automatiquement toutes les quantités d'ingrédients se modifient et que dans cette exemple 0.800 kg s'affiche pour le sorbet mandarine.
Comment procéder?
Merci d'avance pour votre aide.
Dylan
bonjour,
une proposition, macro à ajouter dans le code the thisworkbook. La macro modifie la fiche sélectionnée pour adapter les quantités au nombre de couverts. la fiche originale est donc modifiée.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim nc, oc, i, j, dl
If Sh.Name = "Mercuriale" Or Sh.Name = "Information" Then Exit Sub
If Intersect(Sh.Range("i2"), Target) Is Nothing Then Exit Sub
nc = Sh.Range("i2")
Application.EnableEvents = False
Application.Undo
oc = Sh.Range("i2")
Sh.Range("i2") = nc
dl = Sh.Cells(Rows.Count, 2).End(xlUp).Row
For i = 15 To dl
For j = 4 To 8 ' colonnes D à H
If Sh.Cells(i, j) <> "" Then Sh.Cells(i, j) = Sh.Cells(i, j) * nc / oc
Next j
Next i
Application.EnableEvents = True
End Sub
Slaut,
J'ai tout simplement utilisé le produit en croix.
Change la valeur de I2 et observe.. Je ne sais pas si c'est ça que tu voulais.
bonjour,
une proposition, macro à ajouter dans le code the thisworkbook. La macro modifie la fiche sélectionnée pour adapter les quantités au nombre de couverts. la fiche originale est donc modifiée.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim nc, oc, i, j, dl If Sh.Name = "Mercuriale" Or Sh.Name = "Information" Then Exit Sub If Intersect(Sh.Range("i2"), Target) Is Nothing Then Exit Sub nc = Sh.Range("i2") Application.EnableEvents = False Application.Undo oc = Sh.Range("i2") Sh.Range("i2") = nc dl = Sh.Cells(Rows.Count, 2).End(xlUp).Row For i = 15 To dl For j = 4 To 8 ' colonnes D à H If Sh.Cells(i, j) <> "" Then Sh.Cells(i, j) = Sh.Cells(i, j) * nc / oc Next j Next i Application.EnableEvents = True End Sub
Merci beaucoup