Epurer un enregistrement de macro
T
bonjourt à tous j'ai creer une macro (mais n'étant pas un expert j'ai travaillé avec des enregistrement ) le souci c'est que ca prends 2secondes à s'executer y aurais t'il des manip plus rapide pour accélérer la vitesse(mais il y a pas mal de calcul programmer de A1 à H48 et certaine sont masqué) lorsque je clique sur enregistrer ca déplace ma feuille creer dans un autre classeur. j'ai hate de vous lire en espérant comprendre un minimum vos conseil.
Bonjour
Personnellement, mon PC refuse d'ouvrir ton fichier..
"impossible de l'ouvrir en mode protéger".
Donc sans moi...
Fred
T
ca veut dire que tu ne peux pas l'ouvrir ou que tu prend un risque si tu l'ouvre ?
RE..
Excel refuse de l'ouvrir car mon pc est réglé pour que tous les fichiers venant d'internet.. il ouvre les fichiers en mode protégé... donc il fait l'équivalent d'une ouverture en lecture seule.. et ensuite sur simple appuie de ma part il ouvre le fichier normalement.
Problème mon pc n'arrive pas à l'ouvrir en mode protéger... et j'ai pas forcement envi de changer mes réglages. ...
Désolé
Fred
Bonjour,
voici, je suppose, le code à "simplifier" (?) :
Sub création_recette()
Application.ScreenUpdating = False
Columns("A:E").Select
Selection.ColumnWidth = 20
Range("A1:E49").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.SmallScroll Down:=-15
Range("A5:E5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A25:E25").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A5:E5,A25:E25").Select
Range("A25").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("A5:E5").Select
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("A25:E25").Select
ActiveCell.FormulaR1C1 = "Procédé de fabrication"
Range("A6:A22").Select
Range("A22").Activate
ActiveWindow.SmallScroll Down:=0
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A1:E1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A26:E49").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A24:B24").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A23:B23").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("C24:E24").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A23:B23").Select
ActiveCell.FormulaR1C1 = "otal"
Range("A24:B24").Select
ActiveCell.FormulaR1C1 = "Perte"
Range("A23:B23").Select
ActiveCell.FormulaR1C1 = "Total"
Range("B19").Select
ActiveWindow.SmallScroll Down:=-18
Range( _
"A1,B1,C1,D1,E1,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,A17,A18,A19,A20,A21,A22,A23:B23,A24:B24,A25:E25,A5:E5" _
).Select
Range("A5").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A2:E4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A6:E24").Select
Range("B6").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A25:E25").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A5:E5,A6:A22,A1:E1").Select
Range("A1").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Range("B1,C1,D1").Select
Range("D1").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A7,A9,A11,A13,A15,A17,A19,A21").Select
Range("A21").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.SmallScroll Down:=18
Rows("49:49").Select
Range("F49").Activate
Selection.Delete Shift:=xlUp
Range("A26:E48").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1:E48").Select
Range("A26").Activate
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("A23:B23,A24:B24").Select
Range("A24").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=quantitée"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Selection.AutoFill Destination:=Range("A1:E1"), Type:=xlFillDefault
Range("A7:A22").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=liste_ingrédients"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Range("A7:A22").Select
Calculate
Range("B6").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",VLOOKUP(RC[-1],OFFSET('base de donnée'!R1C1:R1C2,0,0,COUNTA('base de donnée'!C1:C2)-1),2,FALSE))"
Range("A6").Select
ActiveCell.FormulaR1C1 = ""
Range("B6").Select
Selection.AutoFill Destination:=Range("B6:B22"), Type:=xlFillDefault
Range("B6:B22").Select
Range("A8").Select
ActiveCell.FormulaR1C1 = ""
Range("A6").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A6").Select
ActiveCell.FormulaR1C1 = "Ingrédients"
Range("C6").Select
ActiveCell.FormulaR1C1 = "Recette de base"
Range("D6").Select
ActiveCell.FormulaR1C1 = "Recette pour 1kg"
Range("E6").Select
ActiveCell.FormulaR1C1 = "Recette pour production"
Range("E6").Select
Columns("E:E").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Range("J14").Select
Columns("B:B").EntireColumn.AutoFit
Range("C23").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-16]C:R[-1]C)"
Range("F7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[16]C[-3]"
Range("F8").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("F8").Select
Selection.AutoFill Destination:=Range("F8:F22"), Type:=xlFillDefault
Range("F8:F22").Select
Range("D7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-1]/RC[2]"
Range("D7").Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC[-1]/RC[2],0)"
Range("D7").Select
Selection.AutoFill Destination:=Range("D7:D22"), Type:=xlFillDefault
Range("D7:D22").Select
Range("D23").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-16]C:R[-1]C)"
Range("E23").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=R[-21]C[-4]*R[-20]C[-4]+R[-21]C[-3]*R[-20]C[-3]+R[-21]C[-2]*R[-20]C[-2]+R[-21]C[-1]*R[-20]C[-1]+R[-21]C*R[-20]C"
Range("E23").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=(R[-21]C[-4]*R[-20]C[-4]+R[-21]C[-3]*R[-20]C[-3]+R[-21]C[-2]*R[-20]C[-2]+R[-21]C[-1]*R[-20]C[-1]+R[-21]C*R[-20]C)+(R[-21]C[-4]*R[-20]C[-4]+R[-21]C[-3]*R[-20]C[-3]+R[-21]C[-2]*R[-20]C[-2]+R[-21]C[-1]*R[-20]C[-1]+R[-21]C*R[-20]C)*R[1]C[-2]"
Range("H7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[16]C[-3]"
Range("H8").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("H8").Select
Selection.AutoFill Destination:=Range("H8:H22"), Type:=xlFillDefault
Range("H8:H22").Select
Range("E7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[3]*RC[-1]"
Range("E7").Select
Selection.AutoFill Destination:=Range("E7:E22"), Type:=xlFillDefault
Range("E7:E22").Select
Range("F7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[16]C[-3]+R[16]C[-3]*R[17]C[-3]"
Range("F8").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("C7").Select
ActiveCell.FormulaR1C1 = "3"
Range("C8").Select
ActiveCell.FormulaR1C1 = "5"
Range("C24:E24").Select
ActiveCell.FormulaR1C1 = "5%"
Range("E23").Select
ActiveCell.FormulaR1C1 = _
"=(R[-21]C[-4]*R[-20]C[-4]+R[-21]C[-3]*R[-20]C[-3]+R[-21]C[-2]*R[-20]C[-2]+R[-21]C[-1]*R[-20]C[-1]+R[-21]C*R[-20]C)"
Range("A2").Select
ActiveCell.FormulaR1C1 = "10"
Range("A3").Select
ActiveCell.FormulaR1C1 = "5"
Range("E23").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=(R[-21]C[-4]*R[-20]C[-4]+R[-21]C[-3]*R[-20]C[-3]+R[-21]C[-2]*R[-20]C[-2]+R[-21]C[-1]*R[-20]C[-1]+R[-21]C*R[-20]C)+(R[-21]C[-4]*R[-20]C[-4]+R[-21]C[-3]*R[-20]C[-3]+R[-21]C[-2]*R[-20]C[-2]+R[-21]C[-1]*R[-20]C[-1]+R[-21]C*R[-20]C)*R[1]C[-2]"
Range("A2:E2").Select
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0.000"
Range("C7:E23").Select
Selection.NumberFormat = "0.000"
Selection.NumberFormat = "0.0000"
Selection.NumberFormat = "0.000"
Range("C24:E24").Select
ActiveCell.FormulaR1C1 = ""
Range("A2").Select
ActiveCell.FormulaR1C1 = ""
Range("A3").Select
ActiveCell.FormulaR1C1 = ""
Range("G7").Select
ActiveCell.FormulaR1C1 = "=+B7µ"
Range("G7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+RC[-5]*RC[-3]"
Range("G7").Select
ActiveCell.FormulaR1C1 = "=RC[-5]*RC[-3]"
Range("G7").Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC[-5]*RC[-3],0)"
Range("G7").Select
Selection.AutoFill Destination:=Range("G7:G22"), Type:=xlFillDefault
Range("G7:G22").Select
Range("G23").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-16]C:R[-1]C)"
Range("A4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-2]C*R[19]C[6]"
Range("B4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-2]C*R[19]C[5]"
Range("C4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-2]C*R[19]C[4]"
Range("D4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-2]C*R[19]C[3]"
Range("E4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-2]C*R[19]C[2]"
Range("A2").Select
ActiveCell.FormulaR1C1 = "0.5"
Range("A3").Select
ActiveCell.FormulaR1C1 = "1"
Range("A4:E4").Select
Selection.NumberFormat = "#,##0.00 $"
Range("A2").Select
ActiveCell.FormulaR1C1 = ""
Range("A3").Select
ActiveCell.FormulaR1C1 = ""
Range("A7").Select
ActiveCell.FormulaR1C1 = ""
Range("A8").Select
ActiveCell.FormulaR1C1 = ""
Range("C7").Select
ActiveCell.FormulaR1C1 = ""
Range("C8").Select
ActiveCell.FormulaR1C1 = ""
Range("A25:E25,A5:E5").Select
Range("A5").Activate
Selection.Font.Bold = True
Columns("F:H").Select
Selection.EntireColumn.Hidden = True
Range("B:B").EntireColumn.Hidden = True
Range("F7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[16]C[-3]"
Range("F8").Select
Range("E23").Select
ActiveCell.FormulaR1C1 = _
"=(R[-21]C[-4]*R[-20]C[-4]+R[-21]C[-3]*R[-20]C[-3]+R[-21]C[-2]*R[-20]C[-2]+R[-21]C[-1]*R[-20]C[-1]+R[-21]C*R[-20]C)"
Range("C24:E24").Select
Range("F24").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-3]"
Range("F25").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("F25").Select
Selection.AutoFill Destination:=Range("F25:F49"), Type:=xlFillDefault
Range("F25:F49").Select
ActiveWindow.SmallScroll Down:=-21
Range("D7").Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC[-1]/RC[2]+(RC[-1]/RC[2])*R[17]C[2],0)"
Range("D7").Select
Selection.AutoFill Destination:=Range("D7:D22"), Type:=xlFillDefault
Range("H7").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=R[-5]C[-7]*R[-4]C[-7]+R[-5]C[-5]*R[-4]C[-5]+R[-5]C[-4]*R[-4]C[-4]+R[-5]C[-3]*R[-4]C[-3]"
Range("E23").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-16]C:R[-1]C)"
Range("A5").Select
ActiveCell.FormulaR1C1 = "=RIGHT(CELL(""filename""),LEN(CELL(""filename""))-FIND(""]"",CELL(""filename""),1))"
Range("A7").Select
Application.ScreenUpdating = True
End SubA ce niveau ce n'est plus une simplification, c'est une ré écriture qu'il faut, et pour cela il faut savoir quoi faire, afin de l'écrire simplement...
Ou bien alors je n'aie pas récupéré le bon code...
@ bientôt
LouReeD
T
mdr lourred tu m'as fais rire je me doute bien qu'il est long . je ne cest pas comment m'y prendre
T
cette macro fais une mise en place des cellules puis ils y ades formule dans pleins de case et honnetement j'ai peur en cherchant de reduire que ca casse mes calcul
Je comprend mieux le fonctionnement :
on clique sur nouvelle recette et le code crée une feuille avec la fiche de recette, avec les listes de choix, les formules et tout le reste.
Ma question : pourquoi créer cette feuille à partir de rien ?
Le plus simple, si le but est de la garder en archive, est de créer une feuille avec tout ce qu'il faut dessus, puis lors de la création d'une recette, faire un copier/coller de cette feuille "vierge" en lui donnant le nom de la nouvelle recette, du coup plus besoin de code de création avec mise en forme, mise en place de validation de données, de formules, de fusionnement de cellules etc...
Qu'en pensez vous ?
@ bientôt
LouReeD
L'idée : Vous créez une feuille avec votre code afin d'avoir la fiche de créée.
Vous renommez cette feuille en "Vierge".
Vous remplacez votre code "news" avec celui-ci :
Sub news()
Dim C As Variant
Application.ScreenUpdating = False
C = InputBox("Veuillez nommer la nouvelle recette...", "Nom de la recette")
If C <> "" Then ' Si "c" n'est pas vide
Sheets("Vierge").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = C
Else
Exit Sub
End If
Application.ScreenUpdating = True
End SubMais il faudra ajouter un test de non redondance de nom afin de gérer cette erreur éventuelle.
@ bientôt
LouReeD
T
c''est vraiment pas bète en gros si j'ai suivi se que tu as fais c'est que lorsque je lance ta macro copy juste ma feuille ou il y a les macro ducoup ca ne lance pas la mise en forme?
T
vous me parlez de redondances c'est pour eviter les doublons?
Voici le code modifier pour gérer un nom de recette qui se répète :
Sub news()
Dim C As Variant
Application.ScreenUpdating = False
C = InputBox("Veuillez nommer la nouvelle recette...", "Nom de la recette")
On Error GoTo suite
Sheets(C).Activate
MsgBox ("Nom de recette déjà proposée...")
Exit Sub
suite:
If C <> "" Then ' Si "c" n'est pas vide
Sheets("Vierge").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = C
Else
Exit Sub
End If
Application.ScreenUpdating = True
End SubComme cela, si la feuille n'existe pas, cela provoque une erreur sous VBA qui est gérée par le "On Error Goto Suite" du coup le code continue et va créer la feuille avec le nom demandé, et s'il n'y a pas d'erreur, alors la feuille déjà existante est sélectionnée et un MsgBox est affiché qui explique que le nom existe déjà et l'utilisateur est directement sur la feuille existante pour s'en rendre compte et on quitte la procédure.
Avec ce système de feuille vierge tout devient plus simple et votre fiche de menu peut alors avoir la "présentation" que vous voulez sans vous souciez de savoir comment le retranscrire en VBA !
@ bientôt
LouReeD
T
un grand merci
Merci @ vous pour vos remerciements !
Au niveau des tests il y en a d'autre à mettre en place au niveau du nom de la recette, car les noms de feuilles sous Excel doivent respecter un certain format :
caractères interdis, nombre de caractères....
@ bientôt
LouReeD